File Coverage

blib/lib/Test2/Compare/DeepRef.pm
Criterion Covered Total %
statement 44 45 97.7
branch 6 12 50.0
condition n/a
subroutine 10 11 90.9
pod 3 4 75.0
total 63 72 87.5


line stmt bran cond sub pod time code
1             package Test2::Compare::DeepRef;
2 167     167   1206 use strict;
  167         317  
  167         5199  
3 167     167   947 use warnings;
  167         363  
  167         4212  
4              
5 167     167   821 use base 'Test2::Compare::Base';
  167         335  
  167         18056  
6              
7             our $VERSION = '0.000156';
8              
9 167     167   1156 use Test2::Util::HashBase qw/input/;
  167         336  
  167         1079  
10              
11 167     167   21122 use Test2::Util::Ref qw/render_ref rtype/;
  167         375  
  167         10362  
12 167     167   1225 use Scalar::Util qw/refaddr/;
  167         386  
  167         8437  
13 167     167   1081 use Carp qw/croak/;
  167         372  
  167         60821  
14              
15             sub init {
16 4     4 0 56 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 4 50       12 unless $self->{+INPUT};
20              
21             croak "'input' must be a reference, got '" . $self->{+INPUT} . "'"
22 4 50       11 unless ref $self->{+INPUT};
23              
24 4         14 $self->SUPER::init();
25             }
26              
27 0     0 1 0 sub name { '' }
28              
29             sub verify {
30 4     4 1 7 my $self = shift;
31 4         19 my %params = @_;
32 4         13 my ($got, $exists) = @params{qw/got exists/};
33              
34 4 50       8 return 0 unless $exists;
35              
36 4         7 my $in = $self->{+INPUT};
37 4 50       10 return 0 unless ref $in;
38 4 50       8 return 0 unless ref $got;
39              
40 4         10 my $in_type = rtype($in);
41 4         9 my $got_type = rtype($got);
42              
43 4 50       9 return 0 unless $in_type eq $got_type;
44              
45 4         11 return 1;
46             }
47              
48             sub deltas {
49 4     4 1 9 my $self = shift;
50 4         12 my %params = @_;
51 4         10 my ($got, $convert, $seen) = @params{qw/got convert seen/};
52              
53 4         7 my $in = $self->{+INPUT};
54 4         11 my $in_type = rtype($in);
55 4         22 my $got_type = rtype($got);
56            
57 4         11 my $check = $convert->($$in);
58              
59 4         38 return $check->run(
60             id => ['DEREF' => '$*'],
61             convert => $convert,
62             seen => $seen,
63             got => $$got,
64             exists => 1,
65             );
66             }
67              
68              
69              
70             1;
71              
72             __END__