File: | blib/lib/Test/Mocha.pm |
Coverage: | 99.6% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package 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 | |||||||
21 | our @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 | |||||||
52 | sub mock { | ||||||
53 | 66 | 1 | 1748674 | return Test::Mocha::Mock->__new(@_); | |||
54 | } | ||||||
55 | |||||||
56 | sub spy ($) { | ||||||
57 | 4 | 1 | 136525 | return Test::Mocha::Spy->__new(@_); | |||
58 | } | ||||||
59 | |||||||
60 | sub 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 | |||||||
80 | sub 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 | |||||||
89 | sub 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 | |||||||
100 | sub executes (&) { | ||||||
101 | 6 | 1 | 20 | my ($callback) = @_; | |||
102 | 6 | 9 | return $callback; | ||||
103 | } | ||||||
104 | |||||||
105 | ## no critic (RequireArgUnpacking,ProhibitMagicNumbers) | ||||||
106 | sub 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 ||= ×(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) | ||||||
129 | sub 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 | |||||||
141 | sub 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 | |||||||
152 | sub 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 | |||||||
163 | sub 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 | |||||||
175 | sub 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 | |||||||
184 | sub 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 | |||||||
193 | sub 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) | ||||||
207 | sub SlurpyArray () { | ||||||
208 | # uncoverable pod | ||||||
209 | 20 | 0 | 65 | return slurpy(ArrayRef); | |||
210 | } | ||||||
211 | |||||||
212 | sub SlurpyHash () { | ||||||
213 | # uncoverable pod | ||||||
214 | 6 | 0 | 21 | return slurpy(HashRef); | |||
215 | } | ||||||
216 | ## use critic | ||||||
217 | |||||||
218 | sub 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 | |||||||
242 | 1; | ||||||
243 |