@@ -7,22 +7,35 @@ use Carp;
7
7
use SUPER;
8
8
$VERSION = ' 0.175.0' ;
9
9
10
- our $STRICT_MODE ;
11
-
12
10
sub import {
13
11
my ( $class , @args ) = @_ ;
14
12
13
+ # default if no args
14
+ $^H{' Test::MockModule/STRICT_MODE' } = 0;
15
+
15
16
foreach my $arg (@args ) {
16
17
if ( $arg eq ' strict' ) {
17
- $STRICT_MODE = 1;
18
- }
19
- else {
18
+ $^H{' Test::MockModule/STRICT_MODE' } = 1;
19
+ } elsif ( $arg eq ' nostrict' ) {
20
+ $^H{' Test::MockModule/STRICT_MODE' } = 0;
21
+ } else {
20
22
warn " Test::MockModule unknown import option '$arg '" ;
21
23
}
22
24
}
23
-
24
25
return ;
25
26
}
27
+
28
+ sub _strict_mode {
29
+ my $depth = 0;
30
+ while (my @fields = caller ($depth ++)) {
31
+ my $hints = $fields [10];
32
+ if ($hints && grep { / ^Test::MockModule\/ / } keys %{$hints }) {
33
+ return $hints -> {' Test::MockModule/STRICT_MODE' };
34
+ }
35
+ }
36
+ return 0;
37
+ }
38
+
26
39
my %mocked ;
27
40
sub new {
28
41
my $class = shift ;
@@ -102,7 +115,7 @@ sub define {
102
115
sub mock {
103
116
my ($self , @mocks ) = (shift , @_ );
104
117
105
- croak " mock is not allowed in strict mode. Please use define or redefine" if $STRICT_MODE ;
118
+ croak " mock is not allowed in strict mode. Please use define or redefine" if ( $self -> _strict_mode()) ;
106
119
107
120
return $self -> _mock(@mocks );
108
121
}
@@ -140,7 +153,7 @@ sub _mock {
140
153
sub noop {
141
154
my $self = shift ;
142
155
143
- croak " noop is not allowed in strict mode. Please use define or redefine" if $STRICT_MODE ;
156
+ croak " noop is not allowed in strict mode. Please use define or redefine" if ( $self -> _strict_mode()) ;
144
157
145
158
$self -> _mock($_ ,1) for @_ ;
146
159
@@ -287,7 +300,7 @@ Test::MockModule - Override subroutines in a module for unit testing
287
300
}
288
301
289
302
# If you want to prevent noop and mock from working, you can
290
- # load Test::MockModule in strict mode
303
+ # load Test::MockModule in strict mode.
291
304
292
305
use Test::MockModule qw/strict/;
293
306
my $module = Test::MockModule->new('Module::Name');
@@ -298,6 +311,16 @@ Test::MockModule - Override subroutines in a module for unit testing
298
311
# Dies since you specified you wanted strict mode.
299
312
$module->mock('subroutine', sub { ... });
300
313
314
+ # Turn strictness off in this lexical scope
315
+ {
316
+ use Test::MockModule 'nostrict';
317
+ # ->mock() works now
318
+ $module->mock('subroutine', sub { ... });
319
+ }
320
+
321
+ # Back in the strict scope, so mock() dies here
322
+ $module->mock('subroutine', sub { ... });
323
+
301
324
=head1 DESCRIPTION
302
325
303
326
C<Test::MockModule > lets you temporarily redefine subroutines in other packages
@@ -308,6 +331,53 @@ module. The object remembers the original subroutine so it can be easily
308
331
restored. This happens automatically when all MockModule objects for the given
309
332
module go out of scope, or when you C<unmock() > the subroutine.
310
333
334
+ =head1 STRICT MODE
335
+
336
+ One of the weaknesses of testing using mocks is that the implementation of the
337
+ interface that you are mocking might change, while your mocks get left alone.
338
+ You are not now mocking what you thought you were, and your mocks might now be
339
+ hiding bugs that will only be spotted in production. To help prevent this you
340
+ can load Test::MockModule in 'strict' mode:
341
+
342
+ use Test::MockModule qw(strict);
343
+
344
+ This will disable use of the C<mock() > method, making it a fatal runtime error.
345
+ You should instead define mocks using C<redefine() > , which will only mock
346
+ things that already exist and die if you try to redefine something that doesn't
347
+ exist.
348
+
349
+ Strictness is lexically scoped, so you can do this in one file:
350
+
351
+ use Test::MockModule qw(strict);
352
+
353
+ ...->redefine(...);
354
+
355
+ and this in another:
356
+
357
+ use Test::MockModule; # the default is nostrict
358
+
359
+ ...->mock(...);
360
+
361
+ You can even mix n match at different places in a single file thus:
362
+
363
+ use Test::MockModule qw(strict);
364
+ # here mock() dies
365
+
366
+ {
367
+ use Test::MockModule qw(nostrict);
368
+ # here mock() works
369
+ }
370
+
371
+ # here mock() goes back to dieing
372
+
373
+ use Test::MockModule qw(nostrict);
374
+ # and from here on mock() works again
375
+
376
+ NB that strictness must be defined at compile-time, and set using C<use > . If
377
+ you think you're going to try and be clever by calling Test::MockModule's
378
+ C<import() > method at runtime then what happens in undefined, with results
379
+ differing from one version of perl to another. What larks!
380
+
311
381
=head1 METHODS
312
382
313
383
=over 4
538
608
539
609
Original Author: Simon Flack E<lt> simonflk _AT_ cpan.orgE<gt>
540
610
611
+ Lexical scoping of strictness: David Cantrell E<lt> [email protected] E<gt>
612
+
541
613
=head1 COPYRIGHT
542
614
543
615
Copyright 2004 Simon Flack E<lt> simonflk _AT_ cpan.orgE<gt> .
0 commit comments