Mock-Sub-1.09/0000755000175000017500000000000013221247262012426 5ustar steve02steve02Mock-Sub-1.09/Makefile.PL0000644000175000017500000000207213015404230014370 0ustar steve02steve02use 5.006; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Mock::Sub', AUTHOR => q{Steve Bertrand }, VERSION_FROM => 'lib/Mock/Sub.pm', ABSTRACT_FROM => 'lib/Mock/Sub.pm', LICENSE => 'perl_5', PL_FILES => {}, MIN_PERL_VERSION => 5.006, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { bugtracker => { web => 'https://github.com/stevieb9/mock-sub/issues', }, repository => { type => 'git', url => 'https://github.com/stevieb9/mock-sub.git', web => 'https://github.com/stevieb9/mock-sub', }, }, }, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, BUILD_REQUIRES => { 'Test::More' => 0, }, PREREQ_PM => { 'Carp' => 0, 'Scalar::Util' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Mock-Sub-*' }, ); Mock-Sub-1.09/MANIFEST.SKIP0000644000175000017500000000042313015404230014312 0ustar steve02steve02~$ ^blib/ ^pm_to_blib/ .old$ .orig$ .tar.gz$ .bak$ .swp$ ^test/ .hg/ .hgignore$ ^_build/ ^Build$ ^MYMETA\.yml$ ^MYMETA\.json$ ^README.bak$ ^Makefile$ .metadata/ .idea/ pm_to_blib$ .git/ .debug$ .gitignore$ ^\w+.pl$ .ignore.txt$ .travis.yml$ .iml$ examples/ build/ ^\w+.list$ Mock-Sub-1.09/META.json0000664000175000017500000000245013221247262014052 0ustar steve02steve02{ "abstract" : "Mock package, object and standard subroutines, with unit testing in mind.", "author" : [ "Steve Bertrand " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mock-Sub", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Scalar::Util" : "0", "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/stevieb9/mock-sub/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/stevieb9/mock-sub.git", "web" : "https://github.com/stevieb9/mock-sub" } }, "version" : "1.09", "x_serialization_backend" : "JSON::PP version 2.27300_01" } Mock-Sub-1.09/MANIFEST0000644000175000017500000000131113221247262013553 0ustar steve02steve02Changes ignore.txt lib/Mock/Sub.pm lib/Mock/Sub/Child.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/00-load.t t/01-called.t t/02-called_count.t t/03-instantiate.t t/04-return_value.t t/05-side_effect.t t/06-reset.t t/07-name.t t/08-called_with.t t/09-void_context.t t/10-unmock.t t/11-state.t t/12-mocked_subs.t t/13-mocked_objects.t t/14-core_subs.t t/15-remock.t t/16-non_exist_warn.t t/17-no_warnings.t t/18-bug_25-retval_override.t t/19-return_params.t t/data/One.pm t/data/Two.pm t/manifest.t t/pod-coverage.t t/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Mock-Sub-1.09/lib/0000755000175000017500000000000013221247262013174 5ustar steve02steve02Mock-Sub-1.09/lib/Mock/0000755000175000017500000000000013221247262014065 5ustar steve02steve02Mock-Sub-1.09/lib/Mock/Sub.pm0000644000175000017500000002744113221232067015161 0ustar steve02steve02package Mock::Sub; use 5.006; use strict; use warnings; use Carp qw(confess); use Mock::Sub::Child; use Scalar::Util qw(weaken); our $VERSION = '1.09'; my %opts; sub import { my ($class, %args) = @_; %opts = %args; } sub new { my $self = bless {}, shift; %{ $self } = @_; for (keys %opts){ $self->{$_} = $opts{$_}; } return $self; } sub mock { my ($self, $sub, %p) = @_; if (ref($self) ne 'Mock::Sub'){ confess "calling mock() on the Mock::Sub class is no longer permitted. " . "create a new mock object with Mock::Sub->new;, then call mock " . "with my \$sub_object = \$mock->mock('sub_name'); "; } if (! defined wantarray){ confess "\n\ncalling mock() in void context isn't allowed. "; } my $child = Mock::Sub::Child->new(no_warnings => $self->{no_warnings}); my $side_effect = defined $p{side_effect} ? $p{side_effect} : $self->{side_effect}; my $return_value = defined $p{return_value} ? $p{return_value} : $self->{return_value}; $child->side_effect($side_effect); $child->return_value($return_value); $self->{objects}{$sub}{obj} = $child; $child->_mock($sub); # remove the REFCNT to the child, or else DESTROY won't be called weaken $self->{objects}{$sub}{obj}; return $child; } sub mocked_subs { my $self = shift; my @names; for (keys %{ $self->{objects} }) { if ($self->mocked_state($_)){ push @names, $_; } } return @names; } sub mocked_objects { my $self = shift; my @mocked; for (keys %{ $self->{objects} }){ push @mocked, $self->{objects}{$_}{obj}; } return @mocked; } sub mocked_state { my ($self, $sub) = @_; if (! $sub){ confess "calling mocked_state() on a Mock::Sub object requires a sub " . "name to be passed in as its only parameter. "; } eval { my $test = $self->{objects}{$sub}{obj}->mocked_state(); }; if ($@){ confess "can't call mocked_state() on the class if the sub hasn't yet " . "been mocked. "; } return $self->{objects}{$sub}{obj}->mocked_state; } sub DESTROY { } sub __end {}; # vim fold placeholder 1; =head1 NAME Mock::Sub - Mock package, object and standard subroutines, with unit testing in mind. =for html Coverage Status =head1 SYNOPSIS # see EXAMPLES for a full use case and caveats use Mock::Sub; # disable warnings about mocking non-existent subs use Mock::Sub no_warnings => 1 # create the parent mock object my $mock = Mock::Sub->new; # mock some subs... my $foo = $mock->mock('Package::foo'); my $bar = $mock->mock('Package::bar'); # wait until a mocked sub is called Package::foo(); # then... $foo->name; # name of sub that's mocked $foo->called; # was the sub called? $foo->called_count; # how many times was it called? $foo->called_with; # array of params sent to sub # have the mocked sub return something when it's called (list or scalar). $foo->return_value(1, 2, {a => 1}); my @return = Package::foo; # have the mocked sub perform an action $foo->side_effect( sub { die "eval catch" if @_; } ); eval { Package::foo(1); }; like ($@, qr/eval catch/, "side_effect worked with params"); # extract the parameters the sub was called with (if return_value or # side_effect is not used, we will return the parameters that were sent into # the mocked sub (list or scalar context) my @args = $foo->called_with; # reset the mock object for re-use within the same scope $foo->reset; # restore original functionality to the sub $foo->unmock; # re-mock a previously unmock()ed sub $foo->remock; # check if a sub is mocked my $state = $foo->mocked_state; # mock out a CORE:: function. Be warned that this *must* be done within # compile stage (BEGIN), and the function can NOT be unmocked prior # to the completion of program execution my ($mock, $caller); BEGIN { $mock = Mock::Sub->new; $caller = $mock->mock('caller'); }; $caller->return_value(55); caller(); # mocked caller() called =head1 DESCRIPTION Easy to use and very lightweight module for mocking out sub calls. Very useful for testing areas of your own modules where getting coverage may be difficult due to nothing to test against, and/or to reduce test run time by eliminating the need to call subs that you really don't want or need to test. =head1 EXAMPLE Here's a full example to get further coverage where it's difficult if not impossible to test certain areas of your code (eg: you have if/else statements, but they don't do anything but call other subs. You don't want to test the subs that are called, nor do you want to add statements to your code). Note that if the end subroutine you're testing is NOT Object Oriented (and you're importing them into your module that you're testing), you have to mock them as part of your own namespace (ie. instead of Other::first, you'd mock MyModule::first). # module you're testing: package MyPackage; use Other; use Exporter qw(import); @EXPORT_OK = qw(test); my $other = Other->new; sub test { my $arg = shift; if ($arg == 1){ # how do you test this?... there's no return etc. $other->first(); } if ($arg == 2){ $other->second(); } } # your test file use MyPackage qw(test); use Mock::Sub; use Test::More tests => 2; my $mock = Mock::Sub->new; my $first = $mock->mock('Other::first'); my $second = $mock->mock('Other::second'); # coverage for first if() in MyPackage::test test(1); is ($first->called, 1, "1st if() statement covered"); # coverage for second if() test(2); is ($second->called, 1, "2nd if() statement covered"); =head1 MOCK OBJECT METHODS =head2 C Instantiates and returns a new C object, ready to be used to start creating mocked sub objects. Optional options: =over 4 =item C $scalar> Set this to have all mocked subs created with this mock object return anything you wish (accepts a single scalar only. See C method to return a list and for further information). You can also set it in individual mocks only (see C method). =item C $cref> Set this in C to have the side effect passed into all child mocks created with this object. See C method. =back =head2 C Instantiates and returns a new mock object on each call. 'sub' is the name of the subroutine to mock (requires full package name if the sub isn't in C). The mocked sub will return the parameters sent into the mocked sub if a return value isn't set, or a side effect doesn't return anything, if available. If in scalar context but a list was sent in, we'll return the first parameter in the list. In list context, we simply receive the parameters as they were sent in. Optional parameters: See C for a description of the parameters. Both the C and C parameters can be set in this method to individualize each mock object, and will override the global configuration if set in C. There's also C and C methods if you want to set, change or remove these values after instantiation of a child sub object. =head2 mocked_subs Returns a list of all the names of the subs that are currently mocked under the parent mock object. =head2 mocked_objects Returns a list of all sub objects underneath the parent mock object, regardless if its sub is currently mocked or not. =head2 mocked_state('Sub::Name') Returns 1 if the sub currently under the parent mock object is mocked or not, and 0 if not. Croaks if there hasn't been a child sub object created with this sub name. =head1 SUB OBJECT METHODS These methods are for the children mocked sub objects returned from the parent mock object. See L for methods related to the parent mock object. =head2 C Restores the original functionality back to the sub, and runs C on the object. =head2 C Re-mocks the sub within the object after calling C on it (accepts the side_effect and return_value parameters). =head2 C Returns true (1) if the sub being mocked has been called, and false (0) if not. =head2 C Returns the number of times the mocked sub has been called. =head2 C Returns an array of the parameters sent to the subroutine. C if we're called before the mocked sub has been called. =head2 C Returns true (1) if the sub the object refers to is currently mocked, and false (0) if not. =head2 C Returns the name of the sub being mocked. =head2 C Add (or change/delete) a side effect after instantiation. Send in a code reference containing an action you'd like the mocked sub to perform. The side effect function will receive all parameters sent into the mocked sub. You can use both C and C params at the same time. C will be run first, and then C. Note that if C's last expression evaluates to any value whatsoever (even false), it will return that and C will be skipped. To work around this and have the side_effect run but still get the return_value thereafter, write your cref to evaluate undef as the last thing it does: C. =head2 C Add (or change/delete) the mocked sub's return value after instantiation. Can be a scalar or list. Send in C to remove previously set values. =head2 C Resets the functional parameters (C, C), along with C and C back to undef/false. Does not restore the sub back to its original state. =head1 NOTES This module has a backwards parent-child relationship. To use, you create a mock object using L C and C methods, thereafter, you use the returned mocked sub object L to perform the work. The parent mock object retains certain information and statistics of the child mocked objects (and the subs themselves). To mock CORE::GLOBAL functions, you *must* initiate within a C block (see C for details). It is important that if you mock a CORE sub, it can't and won't be returned to its original state until after the entire program process tree exists. Period. I didn't make this a C module (although it started that way) because I can see more uses than placing it into that category. =head1 AUTHOR Steve Bertrand, C<< >> =head1 BUGS Please report any bugs or requests at L =head1 REPOSITORY L =head1 BUILD RESULTS CPAN Testers: L =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Mock::Sub =head1 ACKNOWLEDGEMENTS Python's MagicMock module. =head1 LICENSE AND COPYRIGHT Copyright 2016 Steve Bertrand. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See L for more information. =cut 1; # End of Mock::Sub Mock-Sub-1.09/lib/Mock/Sub/0000755000175000017500000000000013221247262014616 5ustar steve02steve02Mock-Sub-1.09/lib/Mock/Sub/Child.pm0000644000175000017500000001352113221235064016176 0ustar steve02steve02package Mock::Sub::Child; use 5.006; use strict; use warnings; use Carp qw(confess); use Scalar::Util qw(weaken); our $VERSION = '1.09'; sub new { my $self = bless {}, shift; %{ $self } = @_; if ($self->{side_effect}){ $self->_check_side_effect($self->{side_effect}); } return $self; } sub _mock { my $self = shift; # throw away the sub name if it's sent in and we're not called # by Mock::Sub::mock() my $sub_passed_in; if ($_[0] && $_[0] =~ /::/){ $sub_passed_in = 1; } my $caller = (caller(1))[3] || ''; if ($caller ne 'Mock::Sub::mock' && $sub_passed_in){ undef @_; if(ref($self) eq 'Mock::Sub::Child' && ! $self->{name}){ confess "can't call mock() on a child object before it is already " . "initialized with the parent mock object. "; } } if ($caller ne 'Mock::Sub::mock' && $caller ne 'Mock::Sub::Child::remock'){ confess "the _mock() method is not a public API call. For re-mocking " . "an existing sub in an existing sub object, use remock().\n"; } my $sub = $self->name || shift; my %p = @_; for (keys %p){ $self->{$_} = $p{$_}; } if ($sub !~ /::/) { my $core_sub = "CORE::" . $sub; if (defined &$core_sub && ${^GLOBAL_PHASE} eq 'START') { warn "WARNING! we're attempting to override a global core " . "function. You will NOT be able to restore functionality " . "to this function."; $sub = "CORE::GLOBAL::" . $sub; } else { $sub = "main::$sub" if $sub !~ /::/; } } my $fake; if (! exists &$sub && $sub !~ /CORE::GLOBAL/) { $fake = 1; if (! $self->_no_warn) { warn "\n\nWARNING!: we've mocked a non-existent subroutine. ". "the specified sub does not exist.\n\n"; } } $self->_check_side_effect($self->{side_effect}); if (defined $self->{return_value}){ push @{ $self->{return} }, $self->{return_value}; } $self->{name} = $sub; $self->{orig} = \&$sub if ! $fake; $self->{called_count} = 0; { no strict 'refs'; no warnings 'redefine'; my $mock = $self; weaken $mock; *$sub = sub { @{ $mock->{called_with} } = @_; ++$mock->{called_count}; if ($mock->{side_effect}) { if (wantarray){ my @effect = $mock->{side_effect}->(@_); return @effect if @effect; } else { my $effect = $mock->{side_effect}->(@_); return $effect if defined $effect; } } return if ! defined $mock->{return}; if ($mock->{return}[0] && $mock->{return}[0] eq 'params'){ return ! wantarray ? $_[0] : @_; } else { return ! wantarray && @{ $mock->{return} } == 1 ? $mock->{return}[0] : @{ $mock->{return} }; } }; } $self->{state} = 1; return $self; } sub remock { shift->_mock(@_); } sub unmock { my $self = shift; my $sub = $self->{name}; { no strict 'refs'; no warnings 'redefine'; if (defined $self->{orig} && $sub !~ /CORE::GLOBAL/) { *$sub = \&{ $self->{orig} }; } else { undef *$sub if $self->{name}; } } $self->{state} = 0; $self->reset; } sub called { return shift->called_count ? 1 : 0; } sub called_count { return shift->{called_count} || 0; } sub called_with { my $self = shift; if (! $self->called){ confess "\n\ncan't call called_with() before the mocked sub has " . "been called. "; } return @{ $self->{called_with} }; } sub name { return shift->{name}; } sub reset { for (qw(side_effect return_value return called called_count called_with)){ delete $_[0]->{$_}; } } sub return_value { my $self = shift; @{ $self->{return} } = @_; } sub side_effect { $_[0]->_check_side_effect($_[1]); $_[0]->{side_effect} = $_[1]; } sub _check_side_effect { if (defined $_[1] && ref $_[1] ne 'CODE') { confess "\n\nside_effect parameter must be a code reference. "; } } sub mocked_state { return shift->{state}; } sub _no_warn { return $_[0]->{no_warnings}; } sub DESTROY { $_[0]->unmock; } sub _end {}; # vim fold placeholder __END__ =head1 NAME Mock::Sub::Child - Provides for Mock::Sub =head1 METHODS Please refer to the C parent module for full documentation. The descriptions here are just a briefing. =head2 new This method can only be called by the parent C module. =head2 called Returns bool whether the mocked sub has been called yet. =head2 called_count Returns an integer representing the number of times the mocked sub has been called. =head2 called_with Returns a list of arguments the mocked sub was called with. =head2 mock This method should only be called by the parent mock object. You shouldn't be calling this. =head2 remock Re-mocks an unmocked sub back to the same subroutine it was originally mocked with. =head2 mocked_state Returns bool whether the sub the object represents is currently mocked or not. =head2 name Returns the name of the sub this object is mocking. =head2 return_value Send in any values (list or scalar) that you want the mocked sub to return when called. =head2 side_effect Send in a code reference with any actions you want the mocked sub to perform after it's been called. =head2 reset Resets all state of the object back to default (does not unmock the sub). =head2 unmock Restores original functionality of the mocked sub, and calls C on the object. =cut 1; Mock-Sub-1.09/README0000644000175000017500000002252513217012451013307 0ustar steve02steve02NAME Mock::Sub - Mock package, object and standard subroutines, with unit testing in mind. SYNOPSIS # see EXAMPLES for a full use case and caveats use Mock::Sub; # disable warnings about mocking non-existent subs use Mock::Sub no_warnings => 1 # create the parent mock object my $mock = Mock::Sub->new; # mock some subs... my $foo = $mock->mock('Package::foo'); my $bar = $mock->mock('Package::bar'); # wait until a mocked sub is called Package::foo(); # then... $foo->name; # name of sub that's mocked $foo->called; # was the sub called? $foo->called_count; # how many times was it called? $foo->called_with; # array of params sent to sub # have the mocked sub return something when it's called (list or scalar). $foo->return_value(1, 2, {a => 1}); my @return = Package::foo; # have the mocked sub perform an action $foo->side_effect( sub { die "eval catch" if @_; } ); eval { Package::foo(1); }; like ($@, qr/eval catch/, "side_effect worked with params"); # extract the parameters the sub was called with my @args = $foo->called_with; # reset the mock object for re-use within the same scope $foo->reset; # restore original functionality to the sub $foo->unmock; # re-mock a previously unmock()ed sub $foo->remock; # check if a sub is mocked my $state = $foo->mocked_state; # mock out a CORE:: function. Be warned that this *must* be done within # compile stage (BEGIN), and the function can NOT be unmocked prior # to the completion of program execution my ($mock, $caller); BEGIN { $mock = Mock::Sub->new; $caller = $mock->mock('caller'); }; $caller->return_value(55); caller(); # mocked caller() called DESCRIPTION Easy to use and very lightweight module for mocking out sub calls. Very useful for testing areas of your own modules where getting coverage may be difficult due to nothing to test against, and/or to reduce test run time by eliminating the need to call subs that you really don't want or need to test. EXAMPLE Here's a full example to get further coverage where it's difficult if not impossible to test certain areas of your code (eg: you have if/else statements, but they don't do anything but call other subs. You don't want to test the subs that are called, nor do you want to add statements to your code). Note that if the end subroutine you're testing is NOT Object Oriented (and you're importing them into your module that you're testing), you have to mock them as part of your own namespace (ie. instead of Other::first, you'd mock MyModule::first). # module you're testing: package MyPackage; use Other; use Exporter qw(import); @EXPORT_OK = qw(test); my $other = Other->new; sub test { my $arg = shift; if ($arg == 1){ # how do you test this?... there's no return etc. $other->first(); } if ($arg == 2){ $other->second(); } } # your test file use MyPackage qw(test); use Mock::Sub; use Test::More tests => 2; my $mock = Mock::Sub->new; my $first = $mock->mock('Other::first'); my $second = $mock->mock('Other::second'); # coverage for first if() in MyPackage::test test(1); is ($first->called, 1, "1st if() statement covered"); # coverage for second if() test(2); is ($second->called, 1, "2nd if() statement covered"); MOCK OBJECT METHODS new(%opts) Instantiates and returns a new Mock::Sub object, ready to be used to start creating mocked sub objects. Optional options: return_value => $scalar Set this to have all mocked subs created with this mock object return anything you wish (accepts a single scalar only. See return_value() method to return a list and for further information). You can also set it in individual mocks only (see return_value() method). side_effect => $cref Set this in new() to have the side effect passed into all child mocks created with this object. See side_effect() method. mock('sub', %opts) Instantiates and returns a new mock object on each call. 'sub' is the name of the subroutine to mock (requires full package name if the sub isn't in main::). The mocked sub will return undef if a return value isn't set, or a side effect doesn't return anything. Optional parameters: See new() for a description of the parameters. Both the return_value and side_effect parameters can be set in this method to individualize each mock object, and will override the global configuration if set in new(). There's also return_value() and side_effect() methods if you want to set, change or remove these values after instantiation of a child sub object. mocked_subs Returns a list of all the names of the subs that are currently mocked under the parent mock object. mocked_objects Returns a list of all sub objects underneath the parent mock object, regardless if its sub is currently mocked or not. mocked_state('Sub::Name') Returns 1 if the sub currently under the parent mock object is mocked or not, and 0 if not. Croaks if there hasn't been a child sub object created with this sub name. SUB OBJECT METHODS These methods are for the children mocked sub objects returned from the parent mock object. See "MOCK OBJECT METHODS" for methods related to the parent mock object. unmock Restores the original functionality back to the sub, and runs reset() on the object. remock Re-mocks the sub within the object after calling unmock on it (accepts the side_effect and return_value parameters). called Returns true (1) if the sub being mocked has been called, and false (0) if not. called_count Returns the number of times the mocked sub has been called. called_with Returns an array of the parameters sent to the subroutine. confess()s if we're called before the mocked sub has been called. mocked_state Returns true (1) if the sub the object refers to is currently mocked, and false (0) if not. name Returns the name of the sub being mocked. side_effect($cref) Add (or change/delete) a side effect after instantiation. Send in a code reference containing an action you'd like the mocked sub to perform. The side effect function will receive all parameters sent into the mocked sub. You can use both side_effect() and return_value() params at the same time. side_effect will be run first, and then return_value. Note that if side_effect's last expression evaluates to any value whatsoever (even false), it will return that and return_value will be skipped. To work around this and have the side_effect run but still get the return_value thereafter, write your cref to evaluate undef as the last thing it does: sub { ...; undef; }. return_value Add (or change/delete) the mocked sub's return value after instantiation. Can be a scalar or list. Send in undef to remove previously set values. reset Resets the functional parameters (return_value, side_effect), along with called() and called_count() back to undef/false. Does not restore the sub back to its original state. NOTES This module has a backwards parent-child relationship. To use, you create a mock object using "PARENT MOCK OBJECT METHODS" new and mock methods, thereafter, you use the returned mocked sub object METHODS to perform the work. The parent mock object retains certain information and statistics of the child mocked objects (and the subs themselves). To mock CORE::GLOBAL functions, you *must* initiate within a BEGIN block (see SYNOPSIS for details). It is important that if you mock a CORE sub, it can't and won't be returned to its original state until after the entire program process tree exists. Period. I didn't make this a Test:: module (although it started that way) because I can see more uses than placing it into that category. AUTHOR Steve Bertrand, BUGS Please report any bugs or requests at https://github.com/stevieb9/mock-sub/issues REPOSITORY https://github.com/stevieb9/mock-sub BUILD RESULTS CPAN Testers: http://matrix.cpantesters.org/?dist=Mock-Sub SUPPORT You can find documentation for this module with the perldoc command. perldoc Mock::Sub ACKNOWLEDGEMENTS Python's MagicMock module. LICENSE AND COPYRIGHT Copyright 2016 Steve Bertrand. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Mock-Sub-1.09/ignore.txt0000644000175000017500000000031013015404230014433 0ustar steve02steve02Makefile Makefile.old Build Build.bat META.* MYMETA.* .build/ _build/ cover_db/ blib/ inc/ .lwpcookies .last_cover_stats nytprof.out pod2htm*.tmp pm_to_blib Test-MockSub-* Test-MockSub-*.tar.gz *.iml Mock-Sub-1.09/t/0000755000175000017500000000000013221247262012671 5ustar steve02steve02Mock-Sub-1.09/t/04-return_value.t0000644000175000017500000000667113221235151016016 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 27; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; {# return_value my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', return_value => 'True'); Two::test; my $ret = Two::test; is ($foo->called_count, 2, "mock obj with return_value has right call count"); is ($ret, 'True', "mock obj with return_value has right ret val"); } {# return_value my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); my $ret = One::foo(); is ($ret, undef, "no return_value set yet"); $foo->return_value(50); $ret = Two::test; is ($ret, 50, "return_value() does the right thing when adding"); $foo->return_value('hello'); $ret = Two::test; is ($ret, 'hello', "return_value() updates the value properly"); $foo->return_value(undef); $ret = Two::test; is ($ret, undef, "return_value() undef's the value properly"); } {# return_value my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); $foo->return_value(qw(1 2 3)); my @ret = One::foo; is (@ret, 3, "return_value returns list when asked"); is ($ret[0], 1, "return_value list has correct data"); is ($ret[2], 3, "return_value list has correct data"); } {# return_value my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); $foo->return_value('hello'); my @ret = One::foo; my $ret = One::foo; is (@ret, 1, "return_value returns list in context with only a scalar"); is ($ret[0], 'hello', "return_value list has correct data"); is ($ret, 'hello', "in scalar context with a single param, we get data"); $foo->return_value(qw(hello world)); $ret = One::foo(); is ($ret, 2, "in scalar context with list sent in, count is returned"); } {# return_value in new() my $mock = Mock::Sub->new(return_value => 'in_new'); my $ret; my $foo = $mock->mock('One::foo'); $ret = One::foo(); is ($ret, 'in_new', "1st object uses return_value from new()"); my $bar = $mock->mock('One::bar'); $ret = One::bar(); is ($ret, 'in_new', "1st object uses return_value from new()"); $foo->return_value(undef); $ret = One::foo(); is ($ret, undef, "1st object return_value is undef after reset"); $ret = One::bar(); is ( $ret, 'in_new', "2nd obj return_value remains from new() after 1st was reset" ); $foo->return_value('out_of_new'); $ret = One::foo(); is ($ret, 'out_of_new', "1st object return_value obeys return_value()"); $ret = One::bar(); is ( $ret, 'in_new', "2nd obj return_value remains after 1st changed again" ); $bar->return_value(undef); $ret = One::bar(); is ($ret, undef, "2nd object can reset return_value independently"); $ret = One::foo(); is ($ret, 'out_of_new', "...and 1st object is unaffected"); my $mock2 = Mock::Sub->new(return_value => 'mock2'); my $baz = $mock2->mock('One::baz'); $ret = One::baz(); is ($ret, 'mock2', "new obj with new mock sets return_value in new"); $ret = One::foo(); is ($ret, 'out_of_new', "...and objects created with 1st mock are ok"); $baz->return_value('mock2_call'); $ret = One::baz(); is ($ret, 'mock2_call', "obj with 2nd mock return_value() works"); $ret = One::bar(); is ($ret, undef, "...and objects created by first mock are unaffected"); } Mock-Sub-1.09/t/manifest.t0000644000175000017500000000047013015404230014654 0ustar steve02steve02#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); Mock-Sub-1.09/t/06-reset.t0000644000175000017500000000241213221236340014415 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 12; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { # reset() my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', return_value => 99); my $ret1 = Two::test; is ($ret1, 99, "before reset, return_value is ok"); $foo->reset; my $ret2 = Two::test; is ($ret2, undef, "after reset, return_value is reset"); $foo->side_effect( sub {return 10;} ); my $ret3 = Two::test; is ($ret3, 10, "before reset, side_effect does the right thing"); $foo->reset; my $ret4 = Two::test; is ($ret4, undef, "after reset, side_effect does nothing"); $foo = $mock->mock('One::foo'); Two::test; is ($foo->name, 'One::foo', "before reset, obj has sub name"); $foo->reset; is ($foo->name, 'One::foo', "after reset, obj has sub name"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); Two::test; Two::test; is ($foo->called, 1, "before reset, called == 1"); is ($foo->called_count, 2, "before reset, called_count == 2"); $foo->reset; is ($foo->called, 0, "after reset, called == 0"); is ($foo->called_count, 0, "after reset, called_count == 0"); } Mock-Sub-1.09/t/19-return_params.t0000644000175000017500000000154213221236373016172 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use lib 't/data'; BEGIN { use Mock::Sub; use Test::More; use_ok('One'); }; {# return params my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', return_value => 'params'); my $scalar = One::foo(10); is $scalar, 10, "param is returned in scalar context"; $scalar = One::foo(5, 10); is $scalar, 5, "first param is returned in scalar context if list sent in"; my @array = One::foo(1, 2, 3); is @array, $foo->called_with, "number returned params are correct"; is ref \@array, 'ARRAY', "array of params returned in list context"; for(0..2){ is $array[$_], $_ + 1, "returned param $_ is correct"; } $foo->return_value(99); $scalar = One::foo(100); is $scalar, 99, "if return value is set, we return it, not params"; } done_testing(); Mock-Sub-1.09/t/08-called_with.t0000644000175000017500000000457213015404230015561 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More tests => 22; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo(1, 2); my @args = $foo->called_with; is (@args, 2, "called_with() returns the proper number of args"); is ($args[0], 1, "passing (1, 2), first arg is correct"); is ($args[1], 2, "passing (1, 2), second arg is correct") } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo(arg1 => 1, arg2 => 2); my %args = $foo->called_with; is (keys %args, 2, "hash arg returns the proper number of keys"); is ($args{arg1}, 1, "passing arg1=>1, arg2=>2, first arg is correct"); is ($args{arg2}, 2, "passing arg1=>1, arg2=>2, second arg is correct") } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo('hello', {a => 1}, [qw(a b c)]); my ($scalar, $href, $aref) = $foo->called_with; is ($scalar, 'hello', "scalar, href, aref, scalar is correct"); is (ref $href, 'HASH', "scalar, href, aref, href is a hash"); is (ref $aref, 'ARRAY', "scalar, href, aref, aref is an array"); is ($href->{a}, 1, "scalar, href, aref, href has correct data"); is (@$aref, 3, "scalar, href, aref, aref has proper elem count"); is ($aref->[0], 'a', "scalar, href, aref, href has correct data"); is ($aref->[1], 'b', "scalar, href, aref, href has correct data"); is ($aref->[2], 'c', "scalar, href, aref, href has correct data"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo('hello', {a => 1}, [qw(a b c)]); my @args = $foo->called_with; is (@args, 3, "compiling args into array has proper count"); is (ref \$args[0], 'SCALAR', "first arg is correct"); is (ref $args[1], 'HASH', "second arg is correct"); is (ref $args[2], 'ARRAY', "third arg is correct"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); eval { my @args = $foo->called_with; }; like ( $@, qr/can't call called_with/, "called_with() dies if its called before the mocked sub has been" ); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo(); my @args = $foo->called_with; is (@args, 0, "called_with() returns an empty list if no params were used"); } Mock-Sub-1.09/t/13-mocked_objects.t0000644000175000017500000000141513015404230016242 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 11; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); my $bar = $mock->mock('One::bar'); my $baz = $mock->mock('One::baz'); my @objects = $mock->mocked_objects; is (@objects, 3, 'returns correct number of objects'); $foo->unmock; is ($foo->mocked_state, 0, "unmocked sub"); is ($mock->mocked_objects, 3, "after an unmock, return is still correct"); $foo->remock; for my $obj (@objects){ is ($obj->mocked_state, 1, "objects can call state"); like ($obj->name, qr/(?:One::foo|One::bar|One::baz)/, "name is correct on all objects"); } } Mock-Sub-1.09/t/09-void_context.t0000644000175000017500000000255513015404230016007 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More tests => 11; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; eval { Mock::Sub->mock('One::foo', side_effect => sub { die "died"; }); }; like ($@, qr/calling mock\(\) on the Mock::Sub/, "class calling mock() dies"); } { my $mock = Mock::Sub->new; eval { $mock->mock('One::foo', side_effect => sub { die "died"; }); }; like ($@, qr/in void context/, "obj calling mock() in void context dies"); } { my $child = Mock::Sub::Child->new; eval { $child->mock }; like ( $@, qr/Can't locate object method "mock"/, "Mock::Sub::Child no longer has a mock() method" ); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', return_value => 'void'); my $ret = One::foo(); is ($ret, 'void', "configured for the void test"); $foo->unmock; $ret = One::foo(); is ($ret, 'foo', "child object is unmocked"); is ($foo->mocked_state, 0, "confirm child obj is unmocked"); $foo->remock; $ret = One::foo(); is ($foo->mocked_state, 1, "remock() remocks"); is ($ret, undef, "child obj calling remock in void w/ params is mocked"); $foo->remock(return_value => 'void'); $ret = One::foo(); is ($ret, 'void', "child obj calling remock in void with return_value works"); } Mock-Sub-1.09/t/02-called_count.t0000644000175000017500000000151613217012451015727 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; {# called_count() my $mock = Mock::Sub->new; my $test = $mock->mock('One::foo'); Two::test; is ($test->called_count, 1, "does the right thing after one call"); Two::test; Two::test; Two::test; Two::test; is ($test->called_count, 5, "does the right thing after five calls"); $test->reset; is ($test->called_count, 0, "does the right thing after reset"); Two::test; is ($test->called_count, 1, "does the right thing after reset, and one run"); $test->unmock; is ($test->called_count, 0, "does the right thing after unmock"); $test->remock; Two::test; is ($test->called_count, 1, "does the right thing after re-mock"); } Mock-Sub-1.09/t/11-state.t0000644000175000017500000000236613217012451014417 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 12; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); is ($foo->mocked_state, 1, "obj 1 has proper mock state"); is ($mock->mocked_state('One::foo'), 1, "mock has proper mock state on obj 1"); my $bar = $mock->mock('One::bar'); is ($bar->mocked_state, 1, "obj 2 has proper mock state"); is ($bar->mocked_state, 1, "mock has proper mock state on obj 2"); $foo->unmock; is ($foo->mocked_state, 0, "obj 1 has proper unmock state"); is ($mock->mocked_state('One::foo'), 0, "mock has proper ummock state on obj 1"); my $mock2 = Mock::Sub->new; eval { $mock2->mocked_state('One::foo'); }; like ( $@, qr/can't call mocked_state()/, "can't call mocked_state() on parent if a child hasn't been initialized and mocked" ); $foo->remock; is ($foo->mocked_state, 1, "obj has proper mock state with 2 mocks"); is ($foo->mocked_state, 1, "...and original mock obj still has state"); eval { $mock->mocked_state; }; like ($@, qr/calling mocked_state()/, "can't call mocked_state on a top-level obj"); } Mock-Sub-1.09/t/17-no_warnings.t0000644000175000017500000000051113217012451015617 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More; use Mock::Sub no_warnings => 1; { my $warn; $SIG{__WARN__} = sub { $warn = shift; }; my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); is $warn, undef, "no warning on non-existent sub if no_warnings is passed in"; } done_testing(); Mock-Sub-1.09/t/12-mocked_subs.t0000644000175000017500000000155013221231676015577 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 7; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); my $bar = $mock->mock('One::bar'); my $baz = $mock->mock('One::baz'); my @names; @names = $mock->mocked_subs; is (@names, 3, "return is correct"); $foo->unmock; @names = $mock->mocked_subs; is (@names, 2, "after unmock, return is correct"); my @ret1 = grep /One::foo/, @names; is ($ret1[0], undef, "the unmocked sub isn't in the list of names"); $foo->remock('One::foo'); @names = $mock->mocked_subs; my @ret2 = grep /One::foo/, @names; is (@names, 3, "after re-mock, return is correct"); is ($ret2[0], 'One::foo', "the unmocked sub isn't in the list of names"); } Mock-Sub-1.09/t/pod.t0000644000175000017500000000053613015404230013633 0ustar steve02steve02#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Mock-Sub-1.09/t/05-side_effect.t0000644000175000017500000000715513221236274015551 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More tests => 22; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; {# side_effect my $cref = sub {die "throwing error";}; my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', side_effect => $cref); eval{Two::test;}; like ($@, qr/throwing error/, "side_effect with a cref works"); } {# side_effect my $href = {}; my $mock = Mock::Sub->new; eval {my $test = $mock->mock('One::foo', side_effect => $href);}; like ($@, qr/side_effect param/, "mock() dies if side_effect isn't a cref"); } { eval {my $mock = Mock::Sub->mock('One::foo', side_effect => sub {}, return_value => 1);}; # like ($@, qr/use only one of/, "mock() dies if both side_effect and return_value are supplied"); } { my $cref = sub {50}; my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', side_effect => $cref); my $ret = Two::test; is ($ret, 50, "side_effect properly returns a value if die() isn't called") } { my $cref = sub {'False'}; my $mock = Mock::Sub->new; my $foo = $mock->mock( 'One::foo', side_effect => $cref, return_value => 'True'); my $ret = Two::test; is ($ret, 'False', "side_effect with value returns with return_value"); } { my $cref = sub {undef}; my $mock = Mock::Sub->new; my $foo = $mock->mock( 'One::foo', side_effect => $cref, return_value => 'True'); my $ret = Two::test; is ($ret, 'True', "side_effect with no value, return_value returns"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); my $ret = Two::test; is ($ret, undef, "no side effect set yet"); $foo->side_effect(sub {50}); $ret = Two::test; is ($ret, 50, "side_effect() can add an effect after instantiation"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); eval { $foo->side_effect(10); }; like ($@, qr/side_effect parameter/, "side_effect() can add an effect after instantiation" ); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); my $cref = sub { return \@_; }; $foo->side_effect($cref); my $ret = One::foo(1, 2, {3 => 'a'}); is (ref $ret, 'ARRAY', 'side_effect now has access to called_with() args'); is ($ret->[0], 1, 'side_effect 1st arg is 1'); is ($ret->[1], 2, 'side_effect 2nd arg is 2'); is (ref $ret->[2], 'HASH', 'side_effect 3rd arg is a hash'); is ($ret->[2]{3}, 'a', 'side_effect args work properly') } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); $foo->side_effect(sub { return (1, 2, 3); } ); my @ret = One::foo(); is (ref \@ret, 'ARRAY', "in list context, side_effect returns array"); is (@ret, 3, "in list context, side_effect args has right count"); $foo->side_effect(sub { my %h=(a=>1, b=>2); return %h; } ); my %ret = One::foo(); is ($ret{a}, '1', "in list context, a hash is properly created if wanted"); is ($ret{b}, '2', "in list context, a hash is properly created if wanted"); } { # test side_effect in new() my $mock = Mock::Sub->new(side_effect => sub {return 'new'}); my $foo = $mock->mock('One::foo'); use Data::Dumper; my $ret = One::foo(); is ($ret, 'new', "setting side_effect in new applies to obj 1"); my $bar = $mock->mock('One::foo'); $ret = One::foo(); is ($ret, 'new', "setting side_effect in new applies to obj 2"); my $baz = $mock->mock('One::foo'); $ret = One::foo(); is ($ret, 'new', "setting side_effect in new applies to obj 3"); } Mock-Sub-1.09/t/15-remock.t0000644000175000017500000000152213217012451014554 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); eval { $foo->_mock; }; like ($@, qr/\Qthe _mock() method is not a public\E/, "mock() renamed to _mock() no longer callable"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); is ($foo->mocked_state, 1, "sub is mocked"); $foo->unmock; is ($foo->mocked_state, 0, "sub is unmocked"); $foo->remock; is ($foo->mocked_state, 1, "sub is re-mocked with remock()"); eval { $foo->remock; }; is ($@, '', "remock() can be called on an already mocked sub"); $foo->remock(return_value => 55); is (One::foo(), 55, "remocking a mocked sub with a param works"); } done_testing(); Mock-Sub-1.09/t/data/0000755000175000017500000000000013221247262013602 5ustar steve02steve02Mock-Sub-1.09/t/data/Two.pm0000644000175000017500000000030713217012451014704 0ustar steve02steve02package Two; use lib '.'; use One; sub test { my $obj = One->new; $obj->foo; } sub test2 { my $obj = One->new; $obj->bar; } sub test3 { my $obj = One->new; $obj->baz; } 1; Mock-Sub-1.09/t/data/One.pm0000644000175000017500000000022413217012451014652 0ustar steve02steve02package One; sub new { return bless {}, shift; } sub foo { return "foo"; } sub bar { return "bar"; } sub baz { return "baz"; } 1; Mock-Sub-1.09/t/pod-coverage.t0000644000175000017500000000125013015404230015416 0ustar steve02steve02#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Mock-Sub-1.09/t/16-non_exist_warn.t0000644000175000017500000000056013217012451016333 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More; BEGIN { use_ok('Mock::Sub'); }; { my $warn; $SIG{__WARN__} = sub { $warn = shift; }; my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); like $warn, qr/we've mocked a non-existent/, "w/o no_warnings, we warn on non-exist sub"; } done_testing(); Mock-Sub-1.09/t/07-name.t0000644000175000017500000000163013217012451014215 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); One::foo; is ($foo->name, 'One::foo', "name() does the right thing"); } { my $pre_ret1 = foo(); my $pre_ret2 = main::foo(); is ($pre_ret1, 'mainfoo', 'calling a main:: sub without main:: works'); is ($pre_ret2, 'mainfoo', 'calling a main:: sub with main:: works'); my $mock = Mock::Sub->new; my $foo = $mock->mock('foo', return_value => 'mocked_foo'); is ($foo->name, 'main::foo', "name() adds main:: properly"); my $ret1 = foo(); my $ret2 = main::foo(); is ($ret1, 'mocked_foo', 'calling a main:: mock without main:: works'); is ($ret2, 'mocked_foo', 'calling a main:: mock with main:: works'); sub foo { return "mainfoo"; } } Mock-Sub-1.09/t/14-core_subs.t0000644000175000017500000000164313015404230015257 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Data::Dumper; use Test::More; use lib 't/data'; my ($mock, $caller); BEGIN { use_ok('Mock::Sub'); $mock = Mock::Sub->new; my $warning; $SIG{__WARN__} = sub { $warning = shift; }; $caller = $mock->mock('caller'); like ($warning, qr/WARNING!/, "mocking a core global sub warns"); }; is ($caller->mocked_state, 1, "caller() has a mock object"); # below is because CALLER::CORE doesn't show up in 5.14 and below #FIXME ok ($caller->name eq "CORE::GLOBAL::caller" || $caller->name eq "main::caller" , "caller() sub name is correct"); caller(); is ($caller->called, 1, "calling caller() updates the object"); $caller->return_value(55); is (caller(), 55, "caller() can have a return value"); $caller->side_effect( sub { return 7; } ); is (caller(), 7, "...and a side effect"); is ($caller->called_count, 3, "call count is correct"); done_testing(); Mock-Sub-1.09/t/03-instantiate.t0000644000175000017500000000722013217012451015615 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; {# mock() instantiate my $mock = Mock::Sub->new; my $test = $mock->mock('One::foo'); is (ref $test, 'Mock::Sub::Child', "$mock->mock() returns a child object"); Two::test; is ($test->called_count, 1, "instantiating with mock() can call methods"); } {# new() instantiate my $mock = Mock::Sub->new; is (ref $mock, 'Mock::Sub', "instantiating with new() works"); my $test = $mock->mock('One::foo'); Two::test; is ($test->called_count, 1, "instantiating within an object works"); } { my $mock = Mock::Sub->new; is (ref $mock, 'Mock::Sub', "instantiating with new() works"); my $test1 = $mock->mock('One::foo'); my $test2 = $mock->mock('One::bar'); my $test3 = $mock->mock('One::baz'); Two::test; Two::test2; Two::test2; Two::test3; Two::test3; Two::test3; is ($test1->called_count, 1, "1st mock from object does the right thing"); is ($test2->called_count, 2, "2nd mock from object does the right thing"); is ($test3->called_count, 3, "3rd mock from object does the right thing"); Two::test; Two::test2; Two::test2; Two::test3; Two::test3; Two::test3; is ($test1->called_count, 2, "2nd 1st mock from object does the right thing"); is ($test2->called_count, 4, "2nd 2nd mock from object does the right thing"); is ($test3->called_count, 6, "2nd 3rd mock from object does the right thing"); } { my $warn; $SIG{__WARN__} = sub {$warn = 'warned'}; my $mock = Mock::Sub->new; my $test4 = $mock->mock('X::Yes'); is ($warn, 'warned', "mocking a non-existent sub results in a warning"); } { my $mock = Mock::Sub->new; my $test5; eval { $test5 = $mock->mock('testing', return_value => 'True'); }; is ($test5->{name}, 'main::testing', "main:: gets prepended properly"); is ($@, '', "sub param automatically gets main:: if necessary"); is (testing(), 'True', "sub in main:: is called properly") } { $SIG{__WARN__} = sub {}; my $mock = Mock::Sub->new; my $fake = $mock->mock('X::y', return_value => 'true'); my $ret = X::y(); is ($ret, 'true', "successfully mocked a non-existent sub") } { eval { my $foo = Mock::Sub->mock('One::foo'); }; like ($@, qr/no longer permitted/, "can't call mock() from the Mock::Sub class"); } {# new() w/side_effect my $mock = Mock::Sub->new(side_effect => sub { return 55; }); is (ref $mock, 'Mock::Sub', "instantiating with new() works"); my $test = $mock->mock('One::foo'); my $ret = Two::test; is ($ret, 55, "instantiating with side_effect works"); } {# new() w/side_effect my $mock = Mock::Sub->new(side_effect => {a => 1}); is (ref $mock, 'Mock::Sub', "bad side_effect in new for mock works"); eval { my $test = $mock->mock('One::foo'); }; like ($@, qr/side_effect parameter must be a code/, "croaks if side_effect in new is bad"); } {# new() w/side_effect - Child.pm eval { my $child = Mock::Sub::Child->new(side_effect => sub { return 55; }); }; is ($@, '', "instantiating with side_effect in Child works"); } {# new() w/side_effect eval { my $child = Mock::Sub::Child->new(side_effect => {a => 1}); }; like ($@, qr/side_effect parameter must be a code/, "croaks if side_effect in new is bad"); } { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo'); delete $foo->{name}; eval { $foo->_mock('One::foo'); }; like ($@, qr/can't call mock\(\) on a child object/, "can't call mock() from the Mock::Sub class"); } done_testing(); sub testing { return 'testing'; } Mock-Sub-1.09/t/00-load.t0000644000175000017500000000165713015404230014212 0ustar steve02steve02#!perl use 5.006; use strict; use warnings; use Test::More tests => 20; BEGIN { use_ok( 'Mock::Sub' ) || print "Bail out!\n"; use_ok( 'Mock::Sub::Child' ) || print "Bail out!\n"; } diag( "Testing Mock::Sub $Mock::Sub::VERSION, Perl $], $^X" ); can_ok('Mock::Sub', 'new'); can_ok('Mock::Sub', 'mock'); can_ok('Mock::Sub', 'mocked_subs'); can_ok('Mock::Sub', 'mocked_objects'); can_ok('Mock::Sub', 'mocked_state'); can_ok('Mock::Sub', 'DESTROY'); can_ok('Mock::Sub::Child', 'new'); can_ok('Mock::Sub::Child', '_mock'); can_ok('Mock::Sub::Child', 'unmock'); can_ok('Mock::Sub::Child', 'name'); can_ok('Mock::Sub::Child', 'called'); can_ok('Mock::Sub::Child', 'called_count'); can_ok('Mock::Sub::Child', 'called_with'); can_ok('Mock::Sub::Child', 'reset'); can_ok('Mock::Sub::Child', 'return_value'); can_ok('Mock::Sub::Child', 'side_effect'); can_ok('Mock::Sub::Child', '_check_side_effect'); can_ok('Mock::Sub::Child', 'DESTROY'); Mock-Sub-1.09/t/10-unmock.t0000644000175000017500000000465013221013744014571 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More tests => 19; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; { my $mock = Mock::Sub->new; my $foo = $mock->mock('One::foo', return_value => 'Mocked'); my $ret = One::foo(); is ($ret, 'Mocked', "One::foo is mocked"); $foo->unmock; $ret = One::foo(); is ($ret, 'foo', "One::foo is now unmocked with unmock()"); $foo->remock(return_value => 'Mocked'); $ret = One::foo(); is ($foo->called_count, 1, "call count is proper in obj void context"); is ($ret, 'Mocked', "One::foo is mocked after being unmocked"); is ($ret, 'Mocked', "mock() with a child object in void is remocked"); $foo->unmock; $ret = One::foo(); is ($ret, 'foo', "One::foo is now unmocked again"); } { $SIG{__WARN__} = sub {}; my $mock = Mock::Sub->new; my $fake = $mock->mock('X::y', return_value => 'true'); my $ret = X::y(); is ($ret, 'true', "successfully mocked a non-existent sub"); is ($fake->{orig}, undef, "fake mock doesn't keep sub history"); $fake->unmock; eval { X::y(); }; like ($@, qr/Undefined subroutine/, "unmock() unloads the symtab entry for the faked sub" ); } { my $mock = Mock::Sub->new; my $pre_mock_ret = One::foo(); is ($pre_mock_ret, 'foo', "pre_mock value is $pre_mock_ret"); my $obj = $mock->mock('One::foo', return_value => 'mocked'); my $post_mock_ret = One::foo(); is ($post_mock_ret, 'mocked', "post_mock value is $post_mock_ret"); $obj->DESTROY; my $post_destroy_ret = One::foo(); is ($post_destroy_ret, 'foo', "post_destroy value is $post_destroy_ret"); } { # test DESTROY() my $mock = Mock::Sub->new; my $ret = One::foo(); is ($ret, 'foo', "pre_mock value is $ret"); { my $foo = $mock->mock('One::foo', return_value => 'mocked'); my $in_ret = One::foo(); is ($in_ret, 'mocked', "mock value is $in_ret"); } my $post_ret = One::foo(); is ($post_ret, 'foo', "auto destroy/unmock works properly") } { # test DESTROY() no calls my $mock = Mock::Sub->new; my $ret = One::foo(); is ($ret, 'foo', "pre_mock value is $ret"); { my $foo = $mock->mock( 'One::foo', return_value => 'mocked', ); } my $post_ret = One::foo(); is ($post_ret, 'foo', "DESTROY() is called if the mocked sub isn't called") } Mock-Sub-1.09/t/01-called.t0000644000175000017500000000121313015404230014504 0ustar steve02steve02#!/usr/bin/perl use strict; use warnings; use Test::More; use lib 't/data'; BEGIN { use_ok('Two'); use_ok('Mock::Sub'); }; {# called() my $mock = Mock::Sub->new; my $test = $mock->mock('One::foo'); is ($test->called, 0, "called() before a call is correct"); Two::test; is ($test->called, 1, "called() is 1 after one call"); Two::test; is ($test->called, 1, "called() is still 1 after two calls"); $test->unmock; is ($test->called, 0, "after unmock, called() is 0"); $test->remock('One::foo'); Two::test; is ($test->called, 1, "after re-mock, called is 1 again"); } done_testing(); Mock-Sub-1.09/t/18-bug_25-retval_override.t0000644000175000017500000000110613221232354017553 0ustar steve02steve02use strict; use warnings; use Test::More; use Mock::Sub; package Testing; { sub one { return 1; } sub two { return 2; } sub three { return 3; } } package main; my $m = Mock::Sub->new; my $one = $m->mock('Testing::one', return_value => "ok"); my $two = $m->mock('Testing::two'); my $three = $m->mock('Testing::three'); is Testing::one, "ok", "first sub retval set ok"; is Testing::two, undef, "retval set in sub 1 doesn't override sub 2"; is Testing::three, undef, "retval set in sub 1 doesn't override sub 3"; done_testing(); Mock-Sub-1.09/META.yml0000664000175000017500000000134513221247262013704 0ustar steve02steve02--- abstract: 'Mock package, object and standard subroutines, with unit testing in mind.' author: - 'Steve Bertrand ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mock-Sub no_index: directory: - t - inc requires: Carp: '0' Scalar::Util: '0' perl: '5.006' resources: bugtracker: https://github.com/stevieb9/mock-sub/issues repository: https://github.com/stevieb9/mock-sub.git version: '1.09' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mock-Sub-1.09/Changes0000644000175000017500000001106513221247116013722 0ustar steve02steve02Revision history for Mock-Sub 1.09 2017-12-28 - setting a return_value or side_effect when mocking one sub doesn't affect any other subs mocked (fixes #25) - params passed into a mocked sub will only be returned if return_value is set to "params" (closes #26) 1.08 2017-12-21 - the mocked subs now return the parameters that were sent in to it if return_value or side_effect have not been set (closes #24) 1.07 2016-10-05 - POD fix (closes #20) - changed croak() to confess() - you can now add "no_warnings => 1" to the 'use Mock::Sub' line to disable warnings about mocking non-existent subs (closes #22) 1.06 2016-01-23 - new remock() method does what Child::mock() used to do. - Child::mock() renamed to Child::_mock(), and is now private (fixes #17) - more documentation cleanup 1.05 2016-01-22 - added tests for mocked_objects() - Child.pm now has basic pod (mostly to satisfy pod tests) (closes #15) - added .list to MANIFEST.SKIP to ignore RHEL vendor specific build files (reported by Denis Fateyev) (also #15) - this was previously fixed (closes #13) 1.04 2016-01-08 - MANIFEST updates 1.03 2015-12-10 - completely reworked distribution into two modules (parent and Child) - we now have the ability to mock out CORE::GLOBAL functions (eg: caller()). You MUST do the mock within a BEGIN block 1.02 2015-12-09 - fixed bug where if the mocked sub isn't called, the original sub wasn't being restored - called_count() now returns 0 instead of undef if there isn't a count - fix issue #11: called_count wasn't being reset to 0 after reset() - side_effect param can now be sent into new() which will be retained in all child objects created by mock() - return_value param can be send into new(), passed into all child objects - added mocked_objects(), returns a list of objects that have mocked subs (if unmocked(), obj won't be returned) - added mocked_names(), same as mocked_objects() but returns the sub names only - mocked_state(), returns bool whether the named sub is currently mocked 1.01 2015-12-08 - DESTROY() always calls unmock() now. The option to disable this has been removed 0.11 2015-12-08 - if mock() is called in void context, we'll croak (except in the instance where you're re-mocking an unmock()ed sub with the same object) - fixes bug where DESTROY() wasn't able to properly clean up prior to END 0.10 2015-12-07 - all bugs fixed in this release reported by Joel Berger (jberger) - fix issue #5: we now pass in any parameters passed to the mocked function into the side_effect cref - fix issue #6: return_value() now accepts lists (however, using the param version of return_value, only a scalar is accepted). - fix issue #8: called_with() now die()s if it's called before the mocked sub has been - fix issue #7: mocked sub (and the object) is now much more context aware - fix issue #9: DESTROY() now unmock()s by default (keep_mock_on_destroy param to override) 0.09 2015-12-01 - mocking a non-existent sub is now allowed, and spits out a warning message - unmock() removes the symtab entry if mock() created a fake (non-existent) sub entry in the symbol table - added side_effect() and return_value() 0.08 2015-11-30 - fixes bug #3: add eval() in side_effect in SYNOPSIS - fixes bug #2: having side_effect after return_value breaks t/06 - fixes bug #1: add called_with(), to extract the args passed in to the mocked sub - fixes bug #4: completely validate that the sub param is a valid sub - 'main::' is now prepended to subs if they don't have a package - side_effect now properly returns last expression evaluated - side_effect and return_value can now be sent in simultaneously 0.07 2015-11-29 - code cleanup - pod updates - opened bug 1: need to add with_args() 0.04 2015-11-29 - added name() - many more tests - major POD updates/fixes 0.02 2015-11-29 - renamed project from Test::MockSub to Mock::Sub - added numerous test files - added initial POD 0.01 2015-11-29 - initial import