File Coverage

File:blib/lib/Test/Mocha/Mock.pm
Coverage:100.0%

linestmtbrancondsubpodtimecode
1package Test::Mocha::Mock;
2# ABSTRACT: Mock objects
3$Test::Mocha::Mock::VERSION = '0.61';
4
12
12
12
31
21
233
use strict;
5
12
12
12
25
11
199
use warnings;
6
7
12
12
12
26
174
353
use Carp 1.22 'croak';
8
12
12
12
4239
23
225
use Test::Mocha::MethodCall;
9
12
12
12
4946
16
216
use Test::Mocha::MethodStub;
10
12
12
12
38
12
42
use Test::Mocha::Types qw( Matcher Slurpy );
11use Test::Mocha::Util
12
12
12
12
3066
13
427
  qw( check_slurpy_arg extract_method_name find_caller find_stub );
13
12
12
12
29
13
34
use Types::Standard qw( ArrayRef HashRef Str );
14
12
12
12
10388
1051662
70
use UNIVERSAL::ref;
15
16our $AUTOLOAD;
17our $num_method_calls = 0;
18our $last_method_call;
19our $last_response;
20
21# Lookup table of classes for which mock isa() should return false
22my %NOT_ISA =
23  map { $_ => undef } ( 'Type::Tiny', 'Moose::Meta::TypeConstraint', );
24
25# By default, isa(), DOES() and does() should return true for everything, and
26# can() should return a reference to C<AUTOLOAD()> for all methods
27my %DEFAULT_STUBS = (
28    isa => Test::Mocha::MethodStub->new(
29        name      => 'isa',
30        args      => [Str],
31        responses => [ sub { 1 } ],
32    ),
33    DOES => Test::Mocha::MethodStub->new(
34        name      => 'DOES',
35        args      => [Str],
36        responses => [ sub { 1 } ],
37    ),
38    does => Test::Mocha::MethodStub->new(
39        name      => 'does',
40        args      => [Str],
41        responses => [ sub { 1 } ],
42    ),
43    can => Test::Mocha::MethodStub->new(
44        name      => 'can',
45        args      => [Str],
46        responses => [
47            sub {
48                my ( $self, $method_name ) = @_;
49                return sub {
50                    $AUTOLOAD = $method_name;
51                    goto &AUTOLOAD;
52                };
53            }
54        ],
55    ),
56);
57
58sub __new {
59    # uncoverable pod
60
34
38
    my ( $class, $mocked_class ) = @_;
61
62
136
239
    my %args = (
63        mocked_class => $mocked_class,
64        calls        => [],            # ArrayRef[ MethodCall ]
65        stubs        => {              # $method_name => ArrayRef[ MethodStub ]
66
34
86
            map { $_ => [ $DEFAULT_STUBS{$_} ] }
67              keys %DEFAULT_STUBS
68        },
69    );
70
34
100
    return bless \%args, $class;
71}
72
73sub __calls {
74
496
275
    my ($self) = @_;
75
496
520
    return $self->{calls};
76}
77
78sub __mocked_class {
79
266
163
    my ($self) = @_;
80
266
215
    return $self->{mocked_class};
81}
82
83sub __stubs {
84
310
171
    my ($self) = @_;
85
310
327
    return $self->{stubs};
86}
87
88sub AUTOLOAD {
89
273
19351
    my ( $self, @args ) = @_;
90
273
342
    check_slurpy_arg(@args);
91
92
266
290
    my $method_name = extract_method_name($AUTOLOAD);
93
94    # If a class method or module function, then transform method name
95
266
274
    my $mocked_class = $self->__mocked_class;
96
266
267
    if ($mocked_class) {
97
16
19
        if ( $args[0] eq $mocked_class ) {
98
9
6
            shift @args;
99
9
12
            $method_name = "${mocked_class}->${method_name}";
100        }
101        else {
102
7
8
            $method_name = "${mocked_class}::${method_name}";
103        }
104    }
105
106
266
171
    undef $last_method_call;
107
266
344
    undef $last_response;
108
109
266
308
    $num_method_calls++;
110
111    # record the method call for verification
112
266
361
    $last_method_call = Test::Mocha::MethodCall->new(
113        invocant => $self,
114        name     => $method_name,
115        args     => \@args,
116        caller   => [find_caller],
117    );
118
266
266
230
248
    push @{ $self->__calls }, $last_method_call;
119
120    # find a stub to return a response
121
266
308
    my $stub = find_stub( $self, $last_method_call );
122
266
304
    if ( defined $stub ) {
123        # save reference to stub response so it can be restored
124
80
104
        my $responses = $stub->__responses;
125
80
80
49
81
        $last_response = $responses->[0] if @{$responses} > 1;
126
127
80
108
        return $stub->execute_next_response( $self, @args );
128    }
129
186
253
    return;
130}
131
132# Let AUTOLOAD() handle the UNIVERSAL methods
133
134sub isa {
135    # uncoverable pod
136
34
0
795
    my ( $self, $class ) = @_;
137
138    # Handle internal calls from UNIVERSAL::ref::_hook()
139    # when ref($mock) is called
140
34
62
    return 1 if $class eq __PACKAGE__;
141
142    # In order to allow mock methods to be called with other mocks as
143    # arguments, mocks cannot have isa() called with type constraints,
144    # which are not allowed as arguments.
145
30
60
    return if exists $NOT_ISA{$class};
146
147
6
6
    $AUTOLOAD = 'isa';
148
6
13
    goto &AUTOLOAD;
149}
150
151sub DOES {
152    # uncoverable pod
153
22
0
82
    my ( $self, $role ) = @_;
154
155    # Handle internal calls from UNIVERSAL::ref::_hook()
156    # when ref($mock) is called
157
22
38
    return 1 if $role eq __PACKAGE__;
158
159
11
30
    return if !ref $self;
160
161
5
20
    $AUTOLOAD = 'DOES';
162
5
8
    goto &AUTOLOAD;
163}
164
165sub can {
166    # uncoverable pod
167
19
0
1381
    my ( $self, $method_name ) = @_;
168
169    # Handle can('CARP_TRACE') for internal croak()'s (Carp v1.32+)
170
19
466
    return if $method_name eq 'CARP_TRACE';
171
172
5
4
    $AUTOLOAD = 'can';
173
5
10
    goto &AUTOLOAD;
174}
175
176sub ref {  ## no critic (ProhibitBuiltinHomonyms)
177           # uncoverable pod
178
5
0
10
    $AUTOLOAD = 'ref';
179
5
8
    goto &AUTOLOAD;
180}
181
182# Don't let AUTOLOAD() handle DESTROY() so that object can be destroyed
183
2
4
sub DESTROY { }
184
1851;