File Coverage

blib/lib/Test/Spy/Object.pm
Criterion Covered Total %
statement 39 40 97.5
branch 18 20 90.0
condition 12 15 80.0
subroutine 9 11 81.8
pod 0 3 0.0
total 78 89 87.6


line stmt bran cond sub pod time code
1             $Test::Spy::Object::VERSION = '0.003';
2             use v5.10;
3 6     6   77 use strict;
  6         21  
4 6     6   33 use warnings;
  6         11  
  6         141  
5 6     6   30  
  6         13  
  6         254  
6             use Carp qw(croak carp);
7 6     6   35  
  6         11  
  6         3676  
8             our $AUTOLOAD;
9              
10             {
11             my ($self, $name) = @_;
12              
13 6     6 0 149 my $could = $self->SUPER::can($name);
14             return $could if $could;
15 6         40  
16 6 50       21 return undef
17             unless $self->{__spy}->_mocked_subs->{$name}
18             || ($self->{__base} && $self->{__base}->can($name));
19              
20 6 100 100     127 return sub { shift->$name(@_) };
      100        
21             }
22 3     0   17  
  0         0  
23             {
24             my ($self, $name) = @_;
25              
26             return !!1
27 2     2 0 460 if $self->SUPER::isa($name);
28              
29 2 50       14 return !!1
30             if $self->{__base} && $self->{__base}->isa($name);
31              
32             return !!0;
33 2 100 66     18 }
34              
35 1         6 {
36             my ($self, $name) = @_;
37              
38             return !!1
39             if $self->{__base} && $self->{__base}->DOES($name);
40 2     2 0 6  
41             return !!0;
42             }
43 2 100 66     11  
44             {
45 1         39 my ($self, @args) = @_;
46              
47             my $method = $AUTOLOAD;
48             $method =~ s/.*://;
49              
50 45     45   4539 if (my $method = $self->{__spy}->_mocked_subs->{$method}) {
51             # note: immediate return not to force any context
52 45         79 if ($method->isa('Test::Spy::Method')) {
53 45         182 return $method->_called($self, @args);
54             }
55 45 100       186 else {
56             $method->_called($self, @args);
57 37 100       143 }
58 35         112 }
59              
60             if ($self->{__base} && (my $sref = $self->{__base}->can($method))) {
61 2         9 return $sref->($self, @args);
62             }
63              
64             my $interface = $self->{__spy}->interface;
65 10 100 66     62  
66 7         36 croak "No such method $method on Test::Spy->object"
67             if $interface eq 'strict';
68              
69 3         8 carp "method '$1' was called on Test::Spy->object"
70             if $interface eq 'warn';
71 3 100       135  
72             return undef;
73             }
74 2 100       20  
75             {
76             my ($class, %params) = @_;
77 1         18 my $self = \%params;
78              
79             return bless $self, $class;
80             }
81              
82 23     23   105 {
83 23         48 }
84              
85 23         215 1;
86