File Coverage

blib/lib/Class/Mock/Generic/InterfaceTester.pm
Criterion Covered Total %
statement 70 71 98.5
branch 22 22 100.0
condition 9 9 100.0
subroutine 12 12 100.0
pod 1 1 100.0
total 114 115 99.1


line stmt bran cond sub pod time code
1             package Class::Mock::Generic::InterfaceTester;
2              
3 1     1   99431 use strict;
  1         3  
  1         31  
4 1     1   5 use warnings;
  1         2  
  1         45  
5              
6             our $VERSION = '1.3001';
7              
8 1     1   5 use vars qw($AUTOLOAD);
  1         2  
  1         37  
9              
10 1     1   6 use Test::More ();
  1         3  
  1         15  
11 1     1   506 use Data::Compare;
  1         14235  
  1         8  
12 1     1   3748 use Scalar::Util;
  1         2  
  1         39  
13 1     1   469 use Data::Dumper::Concise;
  1         7802  
  1         121  
14              
15             use Class::Mockable
16 1     1   451 _ok => sub { Test::More::ok($_[0], @_[1..$#_]) };
  1         3  
  1         9  
  0         0  
17              
18 1     1   414 use Class::Mock::Common ();
  1         3  
  1         943  
19              
20             =head1 NAME
21              
22             Class::Mock::Generic::InterfaceTester
23              
24             =head1 DESCRIPTION
25              
26             A mock object for testing that you call other code correctly
27              
28             =head1 SYNOPSIS
29              
30             In the code under test:
31              
32             package My::Module;
33              
34             use Class::Mockable
35             _storage_class => 'MyApp::Storage';
36              
37             and in the tests:
38              
39             My::Module->_storage_class(
40             Class::Mock::Generic::InterfaceTester->new([
41             {
42             method => 'fetch',
43             input => [customer_id => 94],
44             output => ...
45             },
46             {
47             method => 'update',
48             input => [status => 'fired', reason => 'non-payment'],
49             output => 1,
50             },
51             ...
52             ]);
53             );
54              
55             or, more simply:
56              
57             my $interface_tester = Class::Mock::Generic::InterfaceTester->new;
58             My::Module->_storage_class($interface_tester);
59            
60             # Expect this method to be called by this test.
61             $interface_tester->add_fixtures(
62             fetch => {
63             input => [customer_id => 94],
64             output => ...
65             },
66             );
67             ok(My::Module->something_that_fetches_from_storage(customer_id => 94));
68              
69             # Expect these two methods to be called by this next test.
70             $interface_tester->add_fixtures(
71             update => {
72             input => [status => 'fired', reason => 'non-payment'],
73             output => 1,
74             },
75             uuid => {
76             output => 'DEADBEEF-1234-5678-9ABC-1234567890AB',
77             }
78             );
79             ok(My::Module->something_that_updates_storage_for_non_payment);
80              
81             You can also create mocks by loading them from a file:
82              
83             my $interface_tester = Class::Mock::Generic::InterfaceTester->new(
84             \"filename.dd"
85             );
86              
87             or:
88              
89             my $interface_tester = Class::Mock::Generic::InterfaceTester->new;
90             $interface_tester->add_fixtures(
91             \"filename.dd"
92             );
93              
94             Yes, that's a reference to a scalar. The scalar is assumed to be a filename
95             which will be read, and whose contents should be valid arguments to create
96             fixtures.
97              
98             =head1 METHODS
99              
100             =head2 new
101              
102             This is the main method. It creates a very simple object. Pass to it a list or
103             arrayref of fixtures (see L for syntax). Any subsequent method
104             calls on that object are handled by AUTOLOAD. Note that because
105             the constructor is Highly Magical you can even provide fixtures for a
106             method called 'new()'. The only ones you can't provide fixtures for are
107             'AUTOLOAD()' and 'DESTROY()', and possibly L.
108              
109             For each method call, the first element is removed from the array of
110             fixtures. We then compare the name of the method that was called with
111             the name of the method we *expected* to be called. If it's wrong, a
112             test failure is emitted. If that matches, we then compare the actual
113             parameters passed to the method with those in the fixture. If they don't
114             match, then that's a test failure. If they do match, then finally the
115             'output' specified in the fixture is returned.
116              
117             Test failures will tell you what the error was, and where the object was created.
118              
119             If you want to do anything more complicated than compare input exactly,
120             then specify a code-ref thus:
121              
122             {
123             method => 'update',
124             input => sub { exists({@_}->{fruit}) && {@_}->{fruit} eq 'apple' },
125             output => 94
126             }
127              
128             In this case, the actual parameters passed to the method will be passed to
129             that code-ref for validation. It should return true if the params are OK
130             and false otherwise. In the example, it will return true if the hash of
131             args contains a 'fruit' key with value 'apple'.
132              
133             If you want to do something more complicated than just return a fixed value
134             then specify a B to a code-ref for the output thus:
135              
136             {
137             method => 'next_value',
138             input => 94,
139             output => \sub { ... }
140             }
141              
142             Note that it must be a reference to a code-ref, to distinguish from the case where
143             you really do want to return a code-ref. The code-ref supplied will be executed and
144             whatever it returns will be returned. If you want to return a reference to a code-ref
145             then you can perpetrate a mess like this:
146              
147             output => sub { \sub { ... } }
148              
149             =head2 add_fixtures
150              
151             Supplied with either an arrayref or a list of method call fixtures, adds them
152             to the array of fixtures this object maintains internally (although see below
153             for a caveat about this).
154              
155             At the simplest, a method call fixture is a hashref with keys
156             C, C and C. If you don't care about the input
157             your method receives, you can omit that key and any input will be accepted.
158              
159             You can also provide a fixture as a pair of C and (hashref containing
160             input and output). This lets you write a series of method call fixtures as an
161             apparent ordered hash, which may feel more natural. As above, you can omit
162             the input field if you don't care. So the following calls are equivalent:
163              
164             $interface_tester->add_fixtures(
165             [
166             {
167             method => 'do_something',
168             input => sub { 1 },
169             output => 'Yup, done',
170             },
171             {
172             method => 'do_something_with_this',
173             input => ['fish'],
174             output => 'Fish cooked',
175             }
176             ]
177             );
178              
179             $interface_tester->add_fixtures(
180             do_something => { output => 'Yup, done' },
181             do_something_with_this => {
182             input => ['fish'],
183             output => 'Fish cooked',
184             },
185             );
186              
187             Caveat: just in case you need to test a call to a method that coincidentally
188             is also called C, this method is only enabled
189             if you did I provide a list of fixtures to the constructor. Note that this
190             means that you can't use C to add a fixture for a method called
191             C!
192              
193             =head2 set_name
194              
195             Takes a scalar parameter and spits that back out at you in any errors, which
196             may make debugging code that used this module easier. This method is only
197             available before you add fixtures. As soon as you add fixtures any calls to
198             C are treated as normal mocked method calls.
199              
200             =head2 DESTROY
201              
202             When the mock object goes out of scope, this is called as usual. It
203             will emit a test failure if not all the fixtures were used.
204              
205             =head1 RECORDING AND PLAYBACK
206              
207             As noted above you can read fixtures from a file by passing a reference to
208             a scalar filename as the first argument to C or C.
209              
210             Recording fixtures to a file is not yet implemented.
211              
212             =cut
213              
214             # You can also record the interactions of your tests with a class by setting the
215             # environment variable PERL_CMGIT_RECORD to a true value and passing some extra
216             # args to C. As well as the reference to a filename, also pass the name of
217             # the class whose input and output you wish to record, and optionally either a
218             # list of methods or a regex that matches method names thus:
219             #
220             # Class::Mock::Generic::InterfaceTester->new(
221             # \"filename.dd",
222             # 'I::Want::To::Mock::This',
223             # qw(but only these methods) # or qr/^(but|only|these|methods)$/
224             # );
225             #
226             # and the mock object will pass args through to the underlying class and record
227             # what happens. If no list of methods or regex is present then all methods will
228             # be recorded, including those inherited from superclasses, except those whose
229             # names begin with an underscore.
230             #
231             # The observant amongst you will have noticed that because when reading from
232             # a file all arguments after the first are ignored, then you can choose to
233             # record or to playback by just setting the environment variable and making
234             # no other changes. This is deliberate.
235              
236             =head1 PHILOSOPHY
237              
238             When you test a piece of code, you want to test it in isolation, because
239             that way when you get test failures it's much easier to find them than if
240             the code you're testing then calls other code, which calls three other
241             modules, which call other modules and so on. If your tests end up running
242             a whole bunch of code other than just the little bit you actually want to
243             test then a failure in any one of those other parts can be very hard to
244             find and fix.
245              
246             You also want to test all of your code's inputs and outputs. Some inputs
247             and outputs are obvious - the parameters you pass to a method are inputs,
248             and its outputs include the return value and any changes in state that the
249             method call makes. For example, in this accessor:
250              
251             package MyApp::SomeModule;
252              
253             sub fruit {
254             my $self = shift;
255             if(@_) { $self->{fruit} = shift; }
256             return $self->{fruit};
257             }
258              
259             the inputs are the argument (if supplied), and the outputs are the return
260             value and, if you supplied an argument, the object's changed internal state.
261              
262             So far, so easy to test.
263              
264             Now consider a slightly more complex accessor:
265              
266             package MyApp::SomeModule;
267              
268             sub fruit {
269             my $self = shift;
270             if(@_) {
271             $self->{fruit} = shift;
272             $self->log(INFO, "fruit changed to ".$self->{fruit});
273             }
274             return $self->{fruit};
275             }
276              
277             sub log {
278             my $self = shift;
279             my $priority = shift;
280             my $message = shift;
281             MyApp::Logger->log($priority, $message);
282             }
283              
284             This accessor has an extra output, the call to $self->log(), the method for
285             which is also shown. But when you're testing the accessor, you don't really
286             want the hassle of setting up and configuring logging, nor do you really want to
287             run all the extra code that that entails, all of which is a potential source
288             of confusing test failures and should itself be run in isolation. So, modify
289             the log() method thus:
290              
291             package MyApp::SomeModule;
292              
293             use Class::Mockable
294             _logger => 'MyApp::Logger';
295              
296             sub log {
297             my $self = shift;
298             my $priority = shift;
299             my $message = shift;
300             $self->_logger()->log($priority, $message);
301             }
302            
303             and in the tests ...
304              
305             MyApp::SomeModule->_logger(
306             Class::Mock::Generic::InterfaceTester->new([
307             {
308             method => 'log',
309             input => [INFO, "fruit changed to apple"],
310             output => "doesn't matter for this test"
311             }
312             ])
313             );
314              
315             ...
316             ok($object->fruit('apple') eq 'apple',
317             "'fruit' accessor returned the right value");
318             ok($object->fruit() eq 'apple',
319             "... yup, the object's internal state looks like it changed");
320              
321             That mocks the logger, but still checks that your code called it correctly.
322             The mocking being in the log() method means that the only application code that
323             got run for this test is the fruit() accessor and the log() method - the logger
324             itself wasn't run, it was mocked - so we have proved that all of the fruit()
325             accessor's inputs and outputs, including the method calls that it makes, are
326             correct.
327              
328             If the log() method call (and hence the call to the mocked logger) is correct,
329             then you shouldn't notice any changes in your tests. But if the accessor's
330             calling of the log() method changes in any way without you also changing the
331             mock (which is effectively a test fixture) then you'll get test failures.
332              
333             =head1 SEE ALSO
334              
335             L is good for faking up troublesome interfaces to
336             third-party systems - for example, for making a wee pretendy third
337             party web service that the code you're testing wants to talk to. You want
338             to mock such things if the third party service is slow, or unreliable, or
339             not available in all your testing environments. You could also use
340             Class::Mock::Generic::InterfaceTester for this, but often Test::MockObject
341             is simpler. Use Test::MockObject if you care mostly about the data you get
342             back from external code, use Class::Mock::Generic::InterfaceTester if you
343             care more about how you call external code.
344              
345             =cut
346              
347             my $_add_fixtures;
348              
349             sub new {
350 19     19 1 166 my $class = shift;
351              
352             # If we're mocking a new method, we don't want to reconstruct the mock
353             # object.
354 19 100       73 if(Scalar::Util::blessed($class)) {
355 2         12 $AUTOLOAD = __PACKAGE__.'::new';
356 2         7 return $class->AUTOLOAD(@_);
357             }
358              
359 17         193 my($sub, $line, $file) = ((caller(1))[3], (caller(0))[2, 1]);
360 17         101 my $caller = sprintf("defined in %s at line %d of %s", $sub, $line, $file);
361 17         77 my $self = bless({
362             called_from => $caller,
363             tests => [],
364             }, $class);
365 17         46 $self->{_fixtures_have_been_set} = 0;
366 17 100       41 if (@_) {
367 10         29 $_add_fixtures->($self, @_);
368             } else {
369 7         22 $self->{_no_fixtures_in_constructor} = 1;
370             }
371 17         53 return $self;
372             }
373              
374             # $_add_fixtures is a coderef rather than a method so we can decide
375             # whether it exists or not based on how the constructor was called,
376             # for maximum backwards-compatibility.
377             #
378              
379             $_add_fixtures = sub {
380             my $self = shift;
381              
382             $self->{_fixtures_have_been_set} = 1;
383              
384             # We might have been passed an arrayref or a list.
385             my @args = (ref($_[0]) eq 'ARRAY' && @_ == 1) ? @{$_[0]} :
386             (ref($_[0]) eq 'SCALAR' && @_ == 1) ? Class::Mock::Common::_get_tests_from_file(${$_[0]}) :
387             @_;
388              
389             # Our fixtures might be raw hashrefs, or method name => hashref pairs.
390             # You can't mix and match.
391             my @fixtures;
392             if (ref($args[0]) eq 'HASH') {
393             @fixtures = @args;
394             } else {
395             while (my ($method, $fixture_details) = splice(@args, 0, 2)) {
396             push @fixtures, { method => $method, %$fixture_details };
397             }
398             }
399              
400             # If input is omitted, we assume we don't care.
401             for (@fixtures) {
402             if (!exists $_->{input}) {
403             $_->{input} = sub { 1 };
404             }
405             }
406              
407             # OK, add these fixtures.
408             push @{ $self->{tests} ||= [] }, @fixtures;
409             };
410              
411             sub AUTOLOAD {
412 42     42   3418 (my $method = $AUTOLOAD) =~ s/.*:://;
413 42         89 my $self = shift;
414 42         101 my @args = @_;
415              
416             # If this is the special method add_fixtures, and we didn't
417             # add fixtures in the constructor (i.e. we expect to add fixtures
418             # bit by bit rather than all at once), add fixtures to our list.
419 42 100 100     223 if ($method eq 'add_fixtures' && $self->{_no_fixtures_in_constructor}) {
    100 100        
420 8         23 return $_add_fixtures->($self, @args);
421             # If we haven't set any fixtures at all then we can assume that the
422             # 'set_name' method is supposed to set this object's name
423             } elsif($method eq 'set_name' && !$self->{_fixtures_have_been_set}) {
424 1         6 $self->{called_from} = "'$args[0]' ".$self->{called_from};
425 1         3 return;
426             }
427              
428             # If we have no more tests, then we've called the mocked $thing more
429             # times than expected - the code under test obviously has more outputs
430             # than expected, which is Bad.
431 33 100       52 if(!@{$self->{tests}}) {
  33         90  
432             __PACKAGE__->_ok()->(0, sprintf (
433             "run out of tests on mock object %s",
434             $self->{called_from}
435 4         25 ));
436 4         1167 return;
437             }
438              
439 29         50 my $next_test = shift(@{$self->{tests}});
  29         61  
440              
441             # Check the correct method was called. If it wasn't, then the code
442             # under test's outputs are not what we expected (they are, at best
443             # in the wrong order), which is Bad.
444 29 100       72 if($next_test->{method} ne $method) {
445             __PACKAGE__->_ok()->( 0,
446             sprintf (
447             "wrong method '%s' (expected '%s') called on mock object %s",
448             $method,
449             $next_test->{method},
450             $self->{called_from},
451             )
452 1         16 );
453 1         305 return;
454             }
455              
456             # Now ensure that the input was as expected. The fixture is normally
457             # provided as an arrayref of expected params, which is (deeply) compared
458             # to what was provided. For more complicated stuff such as where you
459             # are passing an object, or where you just want to check that the args
460             # match a certain pattern (eg did the hash of args contain a 'fruit' key
461             # with value 'apple') then pass in a code-ref.
462 28 100       124 if (ref $next_test->{input} eq 'CODE') {
    100          
463             # pass the args to the code, see if it says they're ok
464 8 100       21 if(!$next_test->{input}->(@args)) {
465             __PACKAGE__->_ok()->(0,
466             sprintf (
467             "wrong args to mock object %s. Got %s.",
468             $self->{called_from},
469 1         9 Dumper(\@args)
470             )
471             );
472             }
473             } elsif (!Compare(\@args, $next_test->{input})) {
474             __PACKAGE__->_ok()->( 0,
475             sprintf (
476             "wrong args to mock object %s (expected %s, got %s)",
477             $self->{called_from},
478 3         320 Dumper($next_test->{input}),
479             Dumper(\@args)
480             )
481             );
482 3         1292 return;
483             }
484 25         2545 my $output = $next_test->{output};
485 25 100 100     84 if(
486             ref($output) eq 'REF' # ref to a ref
487 3         14 && ref(${$output}) eq 'CODE' # ... which is a ref to a sub
488             ) {
489 2         4 return ${$output}->()
  2         6  
490             } else {
491 23         160 return $output
492             }
493             }
494              
495             sub DESTROY {
496 17     17   4173 my $self = shift;
497 17 100       26 if(@{$self->{tests}}) {
  17         232  
498             __PACKAGE__->_ok()->( 0,
499             sprintf (
500             "didn't run all tests in mock object %s (remaining tests: %s)",
501             $self->{called_from},
502 1         5 Dumper( $self->{tests} ),
503             )
504             );
505             }
506             }
507            
508             =head1 AUTHOR
509              
510             Copyright 2012 - 2020 UK2 Ltd and David Cantrell Edavid@cantrell.org.ukE
511              
512             Some contributions from Sam Kington
513              
514             This software is free-as-in-speech software, and may be used, distributed,
515             and modified under the terms of either the GNU General Public Licence
516             version 2 or the Artistic Licence. It's up to you which one you use. The
517             full text of the licences can be found in the files GPL2.txt and
518             ARTISTIC.txt, respectively.
519              
520             =head1 SOURCE CODE REPOSITORY
521              
522             Egit://github.com/DrHyde/perl-modules-Class-Mockable.gitE
523              
524             =head1 BUGS/FEEDBACK
525              
526             Please report bugs at Github
527             Ehttps://github.com/DrHyde/perl-modules-Class-Mockable/issuesE
528              
529             =head1 CONSPIRACY
530              
531             This software is also free-as-in-mason.
532              
533             =cut
534              
535             1;