File Coverage

blib/lib/Test/Mock/Wrapper/Verify.pm
Criterion Covered Total %
statement 54 56 96.4
branch 1 2 50.0
condition 3 5 60.0
subroutine 12 13 92.3
pod 7 8 87.5
total 77 84 91.6


line stmt bran cond sub pod time code
1             package Test::Mock::Wrapper::Verify;
2             $Test::Mock::Wrapper::Verify::VERSION = '0.11';
3 3     3   9 use strict;
  3         3  
  3         74  
4 3     3   9 use warnings;
  3         3  
  3         44  
5 3     3   7 use Test::Deep;
  3         3  
  3         12  
6 3     3   594 use Test::More;
  3         4  
  3         18  
7 3     3   544 use Clone qw(clone);
  3         4  
  3         1094  
8              
9             =head1 NAME
10              
11             Test::Mock::Wrapped::Verify - Part of the Test::Mock::Wrapper module
12              
13             =head1 VERSION
14              
15             version 0.11
16              
17             =head1 SYNOPIS
18              
19             my $verifier = $wrapper->verify('bar');
20            
21             $verifier->at_least(2)->at_most(5);
22            
23             $verifier->with(['zomg'])->never;
24              
25             =head1 DESCRIPTION
26              
27             Instances of this class are returned by Test::Mock::Wrapper::verify to allow for
28             flexible, readible call verification with objects mocked by Test::Mock:Wrapper
29              
30             =head1 METHODS
31              
32             =cut
33              
34             sub new {
35 19     19 0 20 my($proto, $method, $calls) = @_;
36 19   100     29 $calls ||= [];
37 19   33     49 my $class = ref($proto) || $proto;
38 19         87 return bless({__calls=>$calls, method=>$method}, $class);
39             }
40              
41             =head2 getCalls
42              
43             Returns an array of arrays representing all the calls to the mocked method which
44             match any criteria added via a "with" call.
45              
46             =cut
47              
48             sub getCalls {
49 0     0 1 0 my $self = shift;
50 0         0 return clone($self->{__calls});
51             }
52              
53             =head2 with(['some', 'args', ignore()])
54              
55             This returns a new verifier object with a call list which has been filtered using the
56             supplied matcher. See L<Test::Deep> for information about matcher syntax.
57              
58             =cut
59              
60             sub with {
61 5     5 1 38 my $self = shift;
62 5         3 my $matcher = shift;
63 5         4 my (@__calls) = grep({eq_deeply($_, $matcher)} @{ $self->{__calls} });
  22         20090  
  5         8  
64 5         4712 return bless({__calls=>\@__calls, method=>$self->{method}}, ref($self));
65             }
66              
67             =head2 exactly(N)
68              
69             Assert this method was called exactly N times. This is equivelent to
70            
71             =cut
72              
73             sub exactly {
74 4     4 1 4 my $self = shift;
75 4         5 my $times = shift;
76 4         3 ok(scalar(@{ $self->{__calls} }) == $times, "$self->{method} called ".scalar(@{ $self->{__calls} })." times, wanted exactly $times times");
  4         12  
  4         14  
77 4         777 return $self;
78             }
79              
80             =head2 never
81              
82             Assert this method was never called. This is syntatic sugar, equivilent to
83            
84             $verify->exactly(0)
85              
86             =cut
87              
88             sub never {
89 4     4 1 4 my $self = shift;
90 4         10 ok(scalar(@{ $self->{__calls} }) == 0,
  4         5  
91 4 50       4 "$self->{method} should never be called but was called ".scalar(@{ $self->{__calls} })." time".(scalar(@{ $self->{__calls} }) > 1 ? "s":'').".");
  4         14  
92 4         705 return $self;
93             }
94              
95             =head2 once
96              
97             Assert this method was called one time. This is syntatic sugar, equivilent to
98            
99             $verify->exactly(1)
100              
101             =cut
102              
103             sub once {
104 4     4 1 5 my $self = shift;
105 4         2 ok(scalar(@{ $self->{__calls} }) == 1, "$self->{method} should have been called once, but was called ".scalar(@{ $self->{__calls} })." times.");
  4         9  
  4         13  
106 4         719 return $self;
107             }
108              
109             =head2 at_least(N)
110              
111             Assert this method was called at least N times.
112              
113             =cut
114              
115             sub at_least {
116 9     9 1 11 my $self = shift;
117 9         10 my $times = shift;
118 9         7 ok(scalar(@{ $self->{__calls} }) >= $times, "$self->{method} only called ".scalar(@{ $self->{__calls} })." times, wanted at least $times\n");
  9         23  
  9         30  
119 9         1583 return $self;
120             }
121              
122             =head2 at_most(N)
123              
124             Assert this method was called at most N times.
125              
126             =cut
127              
128             sub at_most {
129 2     2 1 2 my $self = shift;
130 2         2 my $times = shift;
131 2         1 ok(scalar(@{ $self->{__calls} }) <= $times, "$self->{method} called ".scalar(@{ $self->{__calls} })." times, wanted at most $times\n");
  2         10  
  2         6  
132 2         331 return $self;
133             }
134              
135              
136             return 42;
137              
138             =head1 AUTHOR
139              
140             Dave Mueller <dave@perljedi.com>
141              
142             =head1 COPYRIGHT AND LICENSE
143              
144             This software is copyright (c) 2015 by Dave Mueller.
145              
146             This is free software; you can redistribute it and/or modify it under the
147             same terms as the Perl 5 programming language system itself.