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
24
24
24
2735488
19
469
use strict;
6
24
24
24
54
17
327
use warnings;
7
8
24
24
24
50
34
845
use Carp 'croak';
9
24
24
24
50
17
307
use Exporter 'import';
10
24
24
24
53
17
689
use Scalar::Util 'blessed';
11
24
24
24
9123
31
278
use Test::Mocha::CalledOk::Times;
12
24
24
24
8702
30
276
use Test::Mocha::CalledOk::AtLeast;
13
24
24
24
8363
35
280
use Test::Mocha::CalledOk::AtMost;
14
24
24
24
8353
28
274
use Test::Mocha::CalledOk::Between;
15
24
24
24
8240
84
470
use Test::Mocha::Mock;
16
24
24
24
12846
34
474
use Test::Mocha::Spy;
17
24
24
24
75
20
159
use Test::Mocha::Types 'NumRange', Mock => { -as => 'MockType' };
18
24
24
24
7837
21
642
use Test::Mocha::Util qw( extract_method_name );
19
24
24
24
54
21
52
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
66
1
1748674
    return Test::Mocha::Mock->__new(@_);
54}
55
56sub spy ($) {
57
4
1
136525
    return Test::Mocha::Spy->__new(@_);
58}
59
60sub stub (&@) {
61
82
1
4928
    my ( $coderef, @responses ) = @_;
62
63
82
89
    foreach (@responses) {
64
78
423
        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
80
200
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
71
68
87
    my $stubs       = $method_call->invocant->__stubs;
72
68
68
60
103
    unshift @{ $stubs->{ $method_call->name } }, $method_call;
73
74    # add response to stub
75
68
158
    Test::Mocha::MethodStub->cast($method_call);
76
68
68
38
81
    push @{ $method_call->__responses }, @responses;
77
68
67
    return;
78}
79
80sub returns (@) {
81
50
1
6938
    my (@return_values) = @_;
82
58
173
    return sub { $return_values[0] }
83
50
190
      if @return_values == 1;
84
4
14
    return sub { @return_values }
85
4
11
      if @return_values > 1;
86
2
4
7
11
    return sub { };  # if @return_values == 0
87}
88
89sub throws (@) {
90
20
1
8619
    my (@exception) = @_;
91
92    # check if first arg is a throwable exception
93
2
6
    return sub { $exception[0]->throw }
94
20
87
      if blessed( $exception[0] ) && $exception[0]->can('throw');
95
96
18
18
48
935
    return sub { croak @exception };
97
98}
99
100sub executes (&) {
101
6
1
20
    my ($callback) = @_;
102
6
9
    return $callback;
103}
104
105## no critic (RequireArgUnpacking,ProhibitMagicNumbers)
106sub called_ok (&;@) {
107
186
1
8822
    my $coderef = shift;
108
109
186
117
    my $called_ok;
110    my $test_name;
111
186
534
    if ( @_ > 0 && ref $_[0] eq 'CODE' ) {
112
114
75
        $called_ok = shift;
113    }
114
186
210
    if ( @_ > 0 ) {
115
106
84
        $test_name = shift;
116    }
117
118
186
368
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
119
120    ## no critic (ProhibitAmpersandSigils)
121
180
153
    local $Test::Builder::Level = $Test::Builder::Level + 1;
122
180
243
    $called_ok ||= &times(1);  # default if no times() is specified
123
180
172
    $called_ok->( $method_call, $test_name );
124
180
312
    return;
125}
126## use critic
127
128## no critic (ProhibitBuiltinHomonyms)
129sub times ($) {
130
160
1
3766
    my ($n) = @_;
131
160
221
    croak 'times() must be given a number'
132      unless Num->check($n);
133
134    return sub {
135
158
93
        my ( $method_call, $test_name ) = @_;
136
158
303
        Test::Mocha::CalledOk::Times->test( $method_call, $n, $test_name );
137
158
1466
    };
138}
139## use critic
140
141sub atleast ($) {
142
8
1
1879
    my ($n) = @_;
143
8
15
    croak 'atleast() must be given a number'
144      unless Num->check($n);
145
146    return sub {
147
6
5
        my ( $method_call, $test_name ) = @_;
148
6
19
        Test::Mocha::CalledOk::AtLeast->test( $method_call, $n, $test_name );
149
6
67
    };
150}
151
152sub atmost ($) {
153
8
1
1676
    my ($n) = @_;
154
8
12
    croak 'atmost() must be given a number'
155      unless Num->check($n);
156
157    return sub {
158
6
5
        my ( $method_call, $test_name ) = @_;
159
6
17
        Test::Mocha::CalledOk::AtMost->test( $method_call, $n, $test_name );
160
6
55
    };
161}
162
163sub between ($$) {
164
14
1
2903
    my ( $lower, $upper ) = @_;
165
14
28
    croak 'between() must be given 2 numbers in ascending order'
166      unless NumRange->check( [ $lower, $upper ] );
167
168    return sub {
169
10
7
        my ( $method_call, $test_name ) = @_;
170
10
28
        Test::Mocha::CalledOk::Between->test( $method_call, [ $lower, $upper ],
171            $test_name );
172
10
97
    };
173}
174
175sub inspect (&) {
176
14
1
1691
    my ($coderef) = @_;
177
14
31
    my $method_call = Test::Mocha::Mock->__capture_method_call($coderef);
178
179    return
180
60
10
67
18
      grep { $method_call->__satisfied_by($_) }
181
10
6
      @{ $method_call->invocant->__calls };
182}
183
184sub inspect_all ($) {
185
4
1
1610
    my ($mock) = @_;
186
187
4
8
    croak 'inspect_all() must be given a mock object'
188      if !MockType->check($mock);
189
190
2
2
3
5
    return @{ $mock->{calls} };
191}
192
193sub clear (@) {
194
6
1
1760
    my @mocks = @_;
195
196    ## no critic (ProhibitBooleanGrep)
197
6
21
    croak 'clear() must be given mock objects only'
198
6
204
      if !@mocks || grep { !MockType->check($_) } @mocks;
199    ## use critic
200
201
2
4
4
8
    @{ $_->__calls } = () foreach @mocks;
202
203
2
4
    return;
204}
205
206## no critic (NamingConventions::Capitalization)
207sub SlurpyArray () {
208    # uncoverable pod
209
20
0
65
    return slurpy(ArrayRef);
210}
211
212sub SlurpyHash () {
213    # uncoverable pod
214
6
0
21
    return slurpy(HashRef);
215}
216## use critic
217
218sub class_mock {
219
6
1
158675
    my ($mocked_class) = @_;
220
221
6
19
    my $module_file = join( q{/}, split q{::}, $mocked_class ) . '.pm';
222
6
7
    my $caller_pkg = caller;
223
24
24
24
24939
20
2332
    no strict 'refs';  ## no critic (TestingAndDebugging::ProhibitNoStrict)
224
225    # make sure the real module is not already loaded
226
6
219
    croak "Package '$mocked_class' is already loaded so it cannot be mocked"
227
6
4
      if defined ${ $caller_pkg . '::INC' }{$module_file};
228
229    # check if package has already been mocked
230
4
129
    croak "Package '$mocked_class' is already mocked"
231
4
3
      if defined *{ $mocked_class . '::AUTOLOAD' }{CODE};
232
233
2
5
    my $mock = mock($mocked_class);
234
235
2
6
    *{ $mocked_class . '::AUTOLOAD' } = sub {
236
32
216
        my ($method) = extract_method_name( our $AUTOLOAD );
237
32
88
        $mock->$method(@_);
238
2
6
    };
239
2
6
    return $mock;
240}
241
2421;
243