|
Packit |
11f908 |
package Test::MockModule;
|
|
Packit |
11f908 |
use strict qw/subs vars/;
|
|
Packit |
11f908 |
use vars qw/$VERSION/;
|
|
Packit |
11f908 |
use Scalar::Util qw/reftype weaken/;
|
|
Packit |
11f908 |
use Carp;
|
|
Packit |
11f908 |
use SUPER;
|
|
Packit |
11f908 |
$VERSION = '0.13';
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my %mocked;
|
|
Packit |
11f908 |
sub new {
|
|
Packit |
11f908 |
my $class = shift;
|
|
Packit |
11f908 |
my ($package, %args) = @_;
|
|
Packit |
11f908 |
if ($package && (my $existing = $mocked{$package})) {
|
|
Packit |
11f908 |
return $existing;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
croak "Cannot mock $package" if $package && $package eq $class;
|
|
Packit |
11f908 |
unless (_valid_package($package)) {
|
|
Packit |
11f908 |
$package = 'undef' unless defined $package;
|
|
Packit |
11f908 |
croak "Invalid package name $package";
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
unless ($args{no_auto} || ${"$package\::VERSION"}) {
|
|
Packit |
11f908 |
(my $load_package = "$package.pm") =~ s{::}{/}g;
|
|
Packit |
11f908 |
TRACE("$package is empty, loading $load_package");
|
|
Packit |
11f908 |
require $load_package;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
TRACE("Creating MockModule object for $package");
|
|
Packit |
11f908 |
my $self = bless {
|
|
Packit |
11f908 |
_package => $package,
|
|
Packit |
11f908 |
_mocked => {},
|
|
Packit |
11f908 |
}, $class;
|
|
Packit |
11f908 |
$mocked{$package} = $self;
|
|
Packit |
11f908 |
weaken $mocked{$package};
|
|
Packit |
11f908 |
return $self;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub DESTROY {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
$self->unmock_all;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub get_package {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
return $self->{_package};
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub redefine {
|
|
Packit |
11f908 |
my ($self, @mocks) = (shift, @_);
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
while ( my ($name, $value) = splice @mocks, 0, 2 ) {
|
|
Packit |
11f908 |
my $sub_name = $self->_full_name($name);
|
|
Packit |
11f908 |
my $coderef = *{$sub_name}{'CODE'};
|
|
Packit |
11f908 |
if ('CODE' ne ref $coderef) {
|
|
Packit |
11f908 |
croak "$sub_name does not exist!";
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
return $self->mock(@_);
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub mock {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
while (my ($name, $value) = splice @_, 0, 2) {
|
|
Packit |
11f908 |
my $code = sub { };
|
|
Packit |
11f908 |
if (ref $value && reftype $value eq 'CODE') {
|
|
Packit |
11f908 |
$code = $value;
|
|
Packit |
11f908 |
} elsif (defined $value) {
|
|
Packit |
11f908 |
$code = sub {$value};
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
TRACE("$name: $code");
|
|
Packit |
11f908 |
croak "Invalid subroutine name: $name" unless _valid_subname($name);
|
|
Packit |
11f908 |
my $sub_name = _full_name($self, $name);
|
|
Packit |
11f908 |
if (!$self->{_mocked}{$name}) {
|
|
Packit |
11f908 |
TRACE("Storing existing $sub_name");
|
|
Packit |
11f908 |
$self->{_mocked}{$name} = 1;
|
|
Packit |
11f908 |
if (defined &{$sub_name}) {
|
|
Packit |
11f908 |
$self->{_orig}{$name} = \&$sub_name;
|
|
Packit |
11f908 |
} else {
|
|
Packit |
11f908 |
$self->{_orig}{$name} = undef;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
TRACE("Installing mocked $sub_name");
|
|
Packit |
11f908 |
_replace_sub($sub_name, $code);
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub noop {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
$self->mock($_,1) for @_;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub original {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
my ($name) = @_;
|
|
Packit |
11f908 |
return carp _full_name($self, $name) . " is not mocked"
|
|
Packit |
11f908 |
unless $self->{_mocked}{$name};
|
|
Packit |
11f908 |
return defined $self->{_orig}{$name} ? $self->{_orig}{$name} : $self->{_package}->super($name);
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
sub unmock {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
for my $name (@_) {
|
|
Packit |
11f908 |
croak "Invalid subroutine name: $name" unless _valid_subname($name);
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $sub_name = _full_name($self, $name);
|
|
Packit |
11f908 |
unless ($self->{_mocked}{$name}) {
|
|
Packit |
11f908 |
carp $sub_name . " was not mocked";
|
|
Packit |
11f908 |
next;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
TRACE("Restoring original $sub_name");
|
|
Packit |
11f908 |
_replace_sub($sub_name, $self->{_orig}{$name});
|
|
Packit |
11f908 |
delete $self->{_mocked}{$name};
|
|
Packit |
11f908 |
delete $self->{_orig}{$name};
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
return $self;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub unmock_all {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
foreach (keys %{$self->{_mocked}}) {
|
|
Packit |
11f908 |
$self->unmock($_);
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub is_mocked {
|
|
Packit |
11f908 |
my $self = shift;
|
|
Packit |
11f908 |
my ($name) = shift;
|
|
Packit |
11f908 |
return $self->{_mocked}{$name};
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub _full_name {
|
|
Packit |
11f908 |
my ($self, $sub_name) = @_;
|
|
Packit |
11f908 |
sprintf "%s::%s", $self->{_package}, $sub_name;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub _valid_package {
|
|
Packit |
11f908 |
defined($_[0]) && $_[0] =~ /^[a-z_]\w*(?:::\w+)*$/i;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub _valid_subname {
|
|
Packit |
11f908 |
$_[0] =~ /^[a-z_]\w*$/i;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub _replace_sub {
|
|
Packit |
11f908 |
my ($sub_name, $coderef) = @_;
|
|
Packit |
11f908 |
# from Test::MockObject
|
|
Packit |
11f908 |
local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
|
|
Packit |
11f908 |
if (defined $coderef) {
|
|
Packit |
11f908 |
*{$sub_name} = $coderef;
|
|
Packit |
11f908 |
} else {
|
|
Packit |
11f908 |
TRACE("removing subroutine: $sub_name");
|
|
Packit |
11f908 |
my ($package, $sub) = $sub_name =~ /(.*::)(.*)/;
|
|
Packit |
11f908 |
my %symbols = %{$package};
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# save a copy of all non-code slots
|
|
Packit |
11f908 |
my %slot;
|
|
Packit |
11f908 |
foreach (qw(ARRAY FORMAT HASH IO SCALAR)) {
|
|
Packit |
11f908 |
next unless defined(my $elem = *{$symbols{$sub}}{$_});
|
|
Packit |
11f908 |
$slot{$_} = $elem;
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# clear the symbol table entry for the subroutine
|
|
Packit |
11f908 |
undef *$sub_name;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# restore everything except the code slot
|
|
Packit |
11f908 |
return unless keys %slot;
|
|
Packit |
11f908 |
foreach (keys %slot) {
|
|
Packit |
11f908 |
*$sub_name = $slot{$_};
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# Log::Trace stubs
|
|
Packit |
11f908 |
sub TRACE {}
|
|
Packit |
11f908 |
sub DUMP {}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
1;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=pod
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 NAME
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Test::MockModule - Override subroutines in a module for unit testing
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 SYNOPSIS
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
use Module::Name;
|
|
Packit |
11f908 |
use Test::MockModule;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
{
|
|
Packit |
11f908 |
my $module = Test::MockModule->new('Module::Name');
|
|
Packit |
11f908 |
$module->mock('subroutine', sub { ... });
|
|
Packit |
11f908 |
Module::Name::subroutine(@args); # mocked
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
#Same effect, but this will die() if other_subroutine()
|
|
Packit |
11f908 |
#doesn't already exist, which is often desirable.
|
|
Packit |
11f908 |
$module->redefine('other_subroutine', sub { ... });
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Module::Name::subroutine(@args); # original subroutine
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# Working with objects
|
|
Packit |
11f908 |
use Foo;
|
|
Packit |
11f908 |
use Test::MockModule;
|
|
Packit |
11f908 |
{
|
|
Packit |
11f908 |
my $mock = Test::MockModule->new('Foo');
|
|
Packit |
11f908 |
$mock->mock(foo => sub { print "Foo!\n"; });
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $foo = Foo->new();
|
|
Packit |
11f908 |
$foo->foo(); # prints "Foo!\n"
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 DESCRIPTION
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
C<Test::MockModule> lets you temporarily redefine subroutines in other packages
|
|
Packit |
11f908 |
for the purposes of unit testing.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
A C<Test::MockModule> object is set up to mock subroutines for a given
|
|
Packit |
11f908 |
module. The object remembers the original subroutine so it can be easily
|
|
Packit |
11f908 |
restored. This happens automatically when all MockModule objects for the given
|
|
Packit |
11f908 |
module go out of scope, or when you C<unmock()> the subroutine.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 METHODS
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=over 4
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item new($package[, %options])
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Returns an object that will mock subroutines in the specified C<$package>.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
If there is no C<$VERSION> defined in C<$package>, the module will be
|
|
Packit |
11f908 |
automatically loaded. You can override this behaviour by setting the C<no_auto>
|
|
Packit |
11f908 |
option:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $mock = Test::MockModule->new('Module::Name', no_auto => 1);
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item get_package()
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Returns the target package name for the mocked subroutines
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item is_mocked($subroutine)
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Returns a boolean value indicating whether or not the subroutine is currently
|
|
Packit |
11f908 |
mocked
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item mock($subroutine =E<gt> \E<amp>coderef)
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Temporarily replaces one or more subroutines in the mocked module. A subroutine
|
|
Packit |
11f908 |
can be mocked with a code reference or a scalar. A scalar will be recast as a
|
|
Packit |
11f908 |
subroutine that returns the scalar.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
The following statements are equivalent:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
$module->mock(purge => 'purged');
|
|
Packit |
11f908 |
$module->mock(purge => sub { return 'purged'});
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
When dealing with references, things behave slightly differently. The following
|
|
Packit |
11f908 |
statements are B<NOT> equivalent:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# Returns the same arrayref each time, with the localtime() at time of mocking
|
|
Packit |
11f908 |
$module->mock(updated => [localtime()]);
|
|
Packit |
11f908 |
# Returns a new arrayref each time, with up-to-date localtime() value
|
|
Packit |
11f908 |
$module->mock(updated => sub { return [localtime()]});
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
The following statements are in fact equivalent:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $array_ref = [localtime()]
|
|
Packit |
11f908 |
$module->mock(updated => $array_ref)
|
|
Packit |
11f908 |
$module->mock(updated => sub { return $array_ref });
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
However, C<undef> is a special case. If you mock a subroutine with C<undef> it
|
|
Packit |
11f908 |
will install an empty subroutine
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
$module->mock(purge => undef);
|
|
Packit |
11f908 |
$module->mock(purge => sub { });
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
rather than a subroutine that returns C<undef>:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
$module->mock(purge => sub { undef });
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
You can call C<mock()> for the same subroutine many times, but when you call
|
|
Packit |
11f908 |
C<unmock()>, the original subroutine is restored (not the last mocked
|
|
Packit |
11f908 |
instance).
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
B<MOCKING + EXPORT>
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
If you are trying to mock a subroutine exported from another module, this may
|
|
Packit |
11f908 |
not behave as you initialy would expect, since Test::MockModule is only mocking
|
|
Packit |
11f908 |
at the target module, not anything importing that module. If you mock the local
|
|
Packit |
11f908 |
package, or use a fully qualified function name, you will get the behavior you
|
|
Packit |
11f908 |
desire:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
use Test::MockModule;
|
|
Packit |
11f908 |
use Test::More;
|
|
Packit |
11f908 |
use POSIX qw/strftime/;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $posix = Test::MockModule->new("POSIX");
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
$posix->mock("strftime", "Yesterday");
|
|
Packit |
11f908 |
is strftime("%D", localtime(time)), "Yesterday", "`strftime` was mocked successfully"; # Fails
|
|
Packit |
11f908 |
is POSIX::strftime("%D", localtime(time)), "Yesterday", "`strftime` was mocked successfully"; # Succeeds
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $main = Test::MockModule->new("main", no_auto => 1);
|
|
Packit |
11f908 |
$main->mock("strftime", "today");
|
|
Packit |
11f908 |
is strftime("%D", localtime(time)), "today", "`strftime` was mocked successfully"; # Succeeds
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
If you are trying to mock a subroutine that was exported into a module that you're
|
|
Packit |
11f908 |
trying to test, rather than mocking the subroutine in its originating module,
|
|
Packit |
11f908 |
you can instead mock it in the module you are testing:
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
package MyModule;
|
|
Packit |
11f908 |
use POSIX qw/strftime/;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
sub minus_twentyfour
|
|
Packit |
11f908 |
{
|
|
Packit |
11f908 |
return strftime("%a, %b %d, %Y", localtime(time - 86400));
|
|
Packit |
11f908 |
}
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
package main;
|
|
Packit |
11f908 |
use Test::More;
|
|
Packit |
11f908 |
use Test::MockModule;
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $posix = Test::MockModule->new("POSIX");
|
|
Packit |
11f908 |
$posix->mock("strftime", "Yesterday");
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
is MyModule::minus_twentyfour(), "Yesterday", "`minus-tewntyfour` got mocked"; # fails
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
my $mymodule = Test::MockModule->new("MyModule", no_auto => 1);
|
|
Packit |
11f908 |
$mymodule->mock("strftime", "Yesterday");
|
|
Packit |
11f908 |
is MyModule::minus_twentyfour(), "Yesterday", "`minus-tewntyfour` got mocked"; # suceeds
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item redefine($subroutine)
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
The same behavior as C<mock()>, but this will preemptively check to be
|
|
Packit |
11f908 |
sure that all passed subroutines actually exist. This is useful to ensure that
|
|
Packit |
11f908 |
if a mocked module's interface changes the test doesn't just keep on testing a
|
|
Packit |
11f908 |
code path that no longer behaves consistently with the mocked behavior.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item original($subroutine)
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Returns the original (unmocked) subroutine
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item unmock($subroutine [, ...])
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Restores the original C<$subroutine>. You can specify a list of subroutines to
|
|
Packit |
11f908 |
C<unmock()> in one go.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item unmock_all()
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Restores all the subroutines in the package that were mocked. This is
|
|
Packit |
11f908 |
automatically called when all C<Test::MockObject> objects for the given package
|
|
Packit |
11f908 |
go out of scope.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=item noop($subroutine [, ...])
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Given a list of subroutine names, mocks each of them with a no-op subroutine. Handy
|
|
Packit |
11f908 |
for mocking methods you want to ignore!
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
# Neuter a list of methods in one go
|
|
Packit |
11f908 |
$module->noop('purge', 'updated');
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=back
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 SEE ALSO
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
L<Test::MockObject::Extends>
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
L<Sub::Override>
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 AUTHORS
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Current Maintainer: Geoff Franks <gfranks@cpan.org>
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Original Author: Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=head1 COPYRIGHT
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
Copyright 2004 Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>.
|
|
Packit |
11f908 |
All rights reserved
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
You may distribute under the terms of either the GNU General Public License or
|
|
Packit |
11f908 |
the Artistic License, as specified in the Perl README file.
|
|
Packit |
11f908 |
|
|
Packit |
11f908 |
=cut
|