File Coverage

File:blib/lib/Test/Mocha.pm
Coverage:99.6%

linestmtbrancondsubpodtimecode
1package Test::Mocha;
2# ABSTRACT: Test Spy/Stub Framework
3$Test::Mocha::VERSION = '0.61';
4
5
12
12
12
1313013
10
229
use strict;
6
12
12
12
29
9
156
use warnings;
7
8
12
12
12
25
19
421
use Carp 'croak';
9
12
12
12
26
9
162
use Exporter 'import';
10
12
12
12
25
7
340
use Scalar::Util 'blessed';
11
12
12
12
4535
16
140
use Test::Mocha::CalledOk::Times;
12
12
12
12
4249
15
135
use Test::Mocha::CalledOk::AtLeast;
13
12
12
12
4166
18
139
use Test::Mocha::CalledOk::AtMost;
14
12
12
12
4182
15
136
use Test::Mocha::CalledOk::Between;
15
12
12
12
4112
37
206
use Test::Mocha::Mock;
16
12
12
12
6011
14
214
use Test::Mocha::Spy;
17
12
12
12
34
10
69
use Test::Mocha::Types 'NumRange', Mock => { -as => 'MockType' };
18
12
12
12
3607
10
289
use Test::Mocha::Util qw( extract_method_name );
19
12
12
12
25
9
25
use Types::Standard qw( ArrayRef HashRef Num slurpy );
20
21our @EXPORT = qw(
22  mock
23  spy
24  class_mock
25  stub
26  returns
27  throws
28  executes
29  called_ok
30  times
31  atleast
32  atmost
33  between
34  verify
35  inspect
36  inspect_all
37  clear
38  SlurpyArray
39  SlurpyHash
40);
41
42# croak() messages should not trace back to Mocha modules
43$Carp::Internal{$_}++ foreach qw(
44  Test::Mocha
45  Test::Mocha::CalledOk
46  Test::Mocha::MethodStub
47  Test::Mocha::Mock
48  Test::Mocha::Spy
49  Test::Mocha::Util
50);
51
52sub mock {
53
33
1
875587
    return Test::Mocha::Mock->__new(@_);
54}
55
56sub spy ($) {
57
2
1
64879
    return Test::Mocha::Spy->__new(@_);
58}
59
60sub stub (&@) {
61
41
1
2346
    my ( $coderef, @responses ) = @_;
62
63
41
44
    foreach (@responses) {
64
39
207
        croak 'stub() responses should be supplied using ',
65          'returns(), throws() or executes()'
66          if ref ne 'CODE';
67    }
68
69    # add stub to mock
70
40
90
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
71
34
39
    my $stubs       = $method_call->invocant->__stubs;
72
34
34
36
54
    unshift @{ $stubs->{ $method_call->name } }, $method_call;
73
74    # add response to stub
75
34
66
    Test::Mocha::MethodStub->cast($method_call);
76
34
34
17
42
    push @{ $method_call->__responses }, @responses;
77
34
30
    return;
78}
79
80sub returns (@) {
81
25
1
3417
    my (@return_values) = @_;
82
29
81
    return sub { $return_values[0] }
83
25
87
      if @return_values == 1;
84
2
7
    return sub { @return_values }
85
2
5
      if @return_values > 1;
86
1
2
3
6
    return sub { };  # if @return_values == 0
87}
88
89sub throws (@) {
90
10
1
4072
    my (@exception) = @_;
91
92    # check if first arg is a throwable exception
93
1
2
    return sub { $exception[0]->throw }
94
10
41
      if blessed( $exception[0] ) && $exception[0]->can('throw');
95
96
9
9
22
453
    return sub { croak @exception };
97
98}
99
100sub executes (&) {
101
3
1
10
    my ($callback) = @_;
102
3
4
    return $callback;
103}
104
105## no critic (RequireArgUnpacking,ProhibitMagicNumbers)
106sub called_ok (&;@) {
107
93
1
4589
    my $coderef = shift;
108
109
93
59
    my $called_ok;
110    my $test_name;
111
93
259
    if ( @_ > 0 && ref $_[0] eq 'CODE' ) {
112
57
35
        $called_ok = shift;
113    }
114
93
111
    if ( @_ > 0 ) {
115
53
44
        $test_name = shift;
116    }
117
118
93
181
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
119
120    ## no critic (ProhibitAmpersandSigils)
121
90
79
    local $Test::Builder::Level = $Test::Builder::Level + 1;
122
90
120
    $called_ok ||= &times(1);  # default if no times() is specified
123
90
86
    $called_ok->( $method_call, $test_name );
124
90
156
    return;
125}
126## use critic
127
128## no critic (ProhibitBuiltinHomonyms)
129sub times ($) {
130
80
1
1931
    my ($n) = @_;
131
80
116
    croak 'times() must be given a number'
132      unless Num->check($n);
133
134    return sub {
135
79
42
        my ( $method_call, $test_name ) = @_;
136
79
153
        Test::Mocha::CalledOk::Times->test( $method_call, $n, $test_name );
137
79
721
    };
138}
139## use critic
140
141sub atleast ($) {
142
4
1
902
    my ($n) = @_;
143
4
8
    croak 'atleast() must be given a number'
144      unless Num->check($n);
145
146    return sub {
147
3
2
        my ( $method_call, $test_name ) = @_;
148
3
10
        Test::Mocha::CalledOk::AtLeast->test( $method_call, $n, $test_name );
149
3
28
    };
150}
151
152sub atmost ($) {
153
4
1
827
    my ($n) = @_;
154
4
6
    croak 'atmost() must be given a number'
155      unless Num->check($n);
156
157    return sub {
158
3
3
        my ( $method_call, $test_name ) = @_;
159
3
8
        Test::Mocha::CalledOk::AtMost->test( $method_call, $n, $test_name );
160
3
26
    };
161}
162
163sub between ($$) {
164
7
1
1449
    my ( $lower, $upper ) = @_;
165
7
15
    croak 'between() must be given 2 numbers in ascending order'
166      unless NumRange->check( [ $lower, $upper ] );
167
168    return sub {
169
5
5
        my ( $method_call, $test_name ) = @_;
170
5
14
        Test::Mocha::CalledOk::Between->test( $method_call, [ $lower, $upper ],
171            $test_name );
172
5
49
    };
173}
174
175sub inspect (&) {
176
7
1
842
    my ($coderef) = @_;
177
7
15
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
178
179    return
180
30
5
33
9
      grep { $method_call->__satisfied_by($_) }
181
5
3
      @{ $method_call->invocant->__calls };
182}
183
184sub inspect_all ($) {
185
2
1
923
    my ($mock) = @_;
186
187
2
4
    croak 'inspect_all() must be given a mock object'
188      if !MockType->check($mock);
189
190
1
1
1
3
    return @{ $mock->{calls} };
191}
192
193sub clear (@) {
194
3
1
847
    my @mocks = @_;
195
196    ## no critic (ProhibitBooleanGrep)
197
3
5
    croak 'clear() must be given mock objects only'
198
3
100
      if !@mocks || grep { !MockType->check($_) } @mocks;
199    ## use critic
200
201
1
2
2
4
    @{ $_->__calls } = () foreach @mocks;
202
203
1
2
    return;
204}
205
206## no critic (NamingConventions::Capitalization)
207sub SlurpyArray () {
208    # uncoverable pod
209
10
0
32
    return slurpy(ArrayRef);
210}
211
212sub SlurpyHash () {
213    # uncoverable pod
214
3
0
10
    return slurpy(HashRef);
215}
216## use critic
217
218sub class_mock {
219
3
1
83361
    my ($mocked_class) = @_;
220
221
3
10
    my $module_file = join( q{/}, split q{::}, $mocked_class ) . '.pm';
222
3
4
    my $caller_pkg = caller;
223
12
12
12
11831
7
1105
    no strict 'refs';  ## no critic (TestingAndDebugging::ProhibitNoStrict)
224
225    # make sure the real module is not already loaded
226
3
111
    croak "Package '$mocked_class' is already loaded so it cannot be mocked"
227
3
2
      if defined ${ $caller_pkg . '::INC' }{$module_file};
228
229    # check if package has already been mocked
230
2
63
    croak "Package '$mocked_class' is already mocked"
231
2
2
      if defined *{ $mocked_class . '::AUTOLOAD' }{CODE};
232
233
1
3
    my $mock = mock($mocked_class);
234
235
1
3
    *{ $mocked_class . '::AUTOLOAD' } = sub {
236
16
110
        my ($method) = extract_method_name( our $AUTOLOAD );
237
16
45
        $mock->$method(@_);
238
1
3
    };
239
1
3
    return $mock;
240}
241
2421;
243