File Coverage

blib/lib/Test/Mocha/Mock.pm
Criterion Covered Total %
statement 64 64 100.0
branch 16 18 88.8
condition n/a
subroutine 15 15 100.0
pod 0 3 100.0
total 95 100 98.0


line stmt bran cond sub pod time code
1             package Test::Mocha::Mock;
2             # ABSTRACT: Mock objects
3             $Test::Mocha::Mock::VERSION = '0.67';
4 13     13   89 use parent 'Test::Mocha::SpyBase';
  13         26  
  13         73  
5 13     13   540 use strict;
  13         77  
  13         262  
6 13     13   65 use warnings;
  13         26  
  13         285  
7              
8 13     13   5959 use Test::Mocha::MethodCall;
  13         258  
  13         479  
9 13     13   6125 use Test::Mocha::MethodStub;
  13         39  
  13         411  
10 13     13   106 use Test::Mocha::Util ();
  13         30  
  13         195  
11 13     13   61 use Types::Standard ();
  13         31  
  13         318  
12 13     13   8757 use if $] lt '5.025', 'UNIVERSAL::ref';
  13         184  
  13         87  
13              
14             our $AUTOLOAD;
15              
16             # Lookup table of classes for which mock isa() should return false
17             my %NOT_ISA =
18             map { $_ => undef } ( 'Type::Tiny', 'Moose::Meta::TypeConstraint', );
19              
20             # By default, isa(), DOES() and does() should return true for everything, and
21             # can() should return a reference to C for all methods
22             my %DEFAULT_STUBS = (
23             isa => Test::Mocha::MethodStub->new(
24             name => 'isa',
25             args => [Types::Standard::Str],
26             responses => [ sub { 1 } ],
27             ),
28             DOES => Test::Mocha::MethodStub->new(
29             name => 'DOES',
30             args => [Types::Standard::Str],
31             responses => [ sub { 1 } ],
32             ),
33             does => Test::Mocha::MethodStub->new(
34             name => 'does',
35             args => [Types::Standard::Str],
36             responses => [ sub { 1 } ],
37             ),
38             ref => Test::Mocha::MethodStub->new(
39             # ref() is a special stub because we use UNIVERSAL::ref which
40             # allows us to call it as a method.
41             name => 'ref',
42             args => [],
43             responses => [ sub { __PACKAGE__ } ],
44             ),
45             can => Test::Mocha::MethodStub->new(
46             name => 'can',
47             args => [Types::Standard::Str],
48             responses => [
49             sub {
50             my ( $self, $method_name ) = @_;
51             return sub {
52             $AUTOLOAD = $method_name;
53             goto &AUTOLOAD;
54             };
55             }
56             ],
57             ),
58             );
59              
60             sub __new {
61             # uncoverable pod
62 22     22   71 my ( $class, $mocked_class ) = @_;
63              
64 22         137 my $args = $class->SUPER::__new;
65              
66 22         61 $args->{mocked_class} = $mocked_class;
67             $args->{stubs} = {
68 22         112 map { $_ => [ $DEFAULT_STUBS{$_} ] }
  110         282  
69             keys %DEFAULT_STUBS
70             };
71 22         102 return bless $args, $class;
72             }
73              
74             sub __mocked_class {
75 255     255   454 my ($self) = @_;
76 255         486 return $self->{mocked_class};
77             }
78              
79             sub AUTOLOAD {
80 262     262   30297 my ( $self, @args ) = @_;
81 262         890 Test::Mocha::Util::check_slurpy_arg(@args);
82              
83 255         550 my $method_name = Test::Mocha::Util::extract_method_name($AUTOLOAD);
84              
85             # If a class method or module function, then transform method name
86 255         566 my $mocked_class = $self->__mocked_class;
87 255 100       559 if ($mocked_class) {
88 16 100       40 if ( $args[0] eq $mocked_class ) {
89 9         12 shift @args;
90 9         22 $method_name = "${mocked_class}->${method_name}";
91             }
92             else {
93 7         15 $method_name = "${mocked_class}::${method_name}";
94             }
95             }
96              
97 255         709 my $method_call = Test::Mocha::MethodCall->new(
98             invocant => $self,
99             name => $method_name,
100             args => \@args,
101             caller => [Test::Mocha::Util::find_caller],
102             );
103              
104 255 100       756 if ( $self->__CaptureMode ) {
105 135         396 $self->__CaptureMethodCall($method_call);
106 135         342 return;
107             }
108              
109             # record the method call to allow for verification
110 120         203 push @{ $self->__calls }, $method_call;
  120         640  
111              
112             # find a stub to return a response
113 120 100       392 if ( my $stub = $self->__find_stub($method_call) ) {
114 54         8286 return $stub->execute_next_response( $self, @args );
115             }
116 66         208 return;
117             }
118              
119             # Let AUTOLOAD() handle the UNIVERSAL methods
120              
121             sub isa {
122             # uncoverable pod
123 11     11 0 722 my ( $self, $class ) = @_;
124              
125             # Don't let AUTOLOAD handle internal isa() calls
126 11 100       98 return 1 if $self->SUPER::isa($class);
127              
128             # In order to allow mock methods to be called with other mocks as
129             # arguments, mocks cannot have isa() called with type constraints,
130             # which are not allowed as arguments.
131 8 100       29 return if exists $NOT_ISA{$class};
132              
133 6         12 $AUTOLOAD = 'isa';
134 6         26 goto &AUTOLOAD;
135             }
136              
137             sub DOES {
138             # uncoverable pod
139 5     5 0 20 my ( $self, $role ) = @_;
140              
141             # Handle internal calls from UNIVERSAL::ref::_hook()
142             # when ref($mock) is called
143 5 50       16 return 1 if $role eq __PACKAGE__;
144              
145 5 50       13 return if !ref $self;
146              
147 5         9 $AUTOLOAD = 'DOES';
148 5         16 goto &AUTOLOAD;
149             }
150              
151             sub can {
152             # uncoverable pod
153 18     18 0 3168 my ( $self, $method_name ) = @_;
154              
155             # Handle can('CARP_TRACE') for internal croak()'s (Carp v1.32+)
156 18 100       227 return if $method_name eq 'CARP_TRACE';
157              
158 5         11 $AUTOLOAD = 'can';
159 5         16 goto &AUTOLOAD;
160             }
161              
162             # Don't let AUTOLOAD() handle DESTROY() so that object can be destroyed
163       1     sub DESTROY { }
164              
165             1;