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   1151 use strict;
  167         400  
  167         4839  
3 167     167   915 use warnings;
  167         352  
  167         4416  
4              
5 167     167   882 use base 'Test2::Compare::Base';
  167         350  
  167         19392  
6              
7             our $VERSION = '0.000155';
8              
9 167     167   1214 use Test2::Util::HashBase qw/input/;
  167         432  
  167         1066  
10              
11 167     167   23005 use Test2::Util::Ref qw/render_ref rtype/;
  167         361  
  167         8760  
12 167     167   1113 use Scalar::Util qw/refaddr/;
  167         582  
  167         7833  
13 167     167   1053 use Carp qw/croak/;
  167         375  
  167         59742  
14              
15             sub init {
16 4     4 0 59 my $self = shift;
17              
18             croak "'input' is a required attribute"
19 4 50       14 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 6 my $self = shift;
31 4         12 my %params = @_;
32 4         11 my ($got, $exists) = @params{qw/got exists/};
33              
34 4 50       10 return 0 unless $exists;
35              
36 4         7 my $in = $self->{+INPUT};
37 4 50       9 return 0 unless ref $in;
38 4 50       10 return 0 unless ref $got;
39              
40 4         10 my $in_type = rtype($in);
41 4         14 my $got_type = rtype($got);
42              
43 4 50       16 return 0 unless $in_type eq $got_type;
44              
45 4         10 return 1;
46             }
47              
48             sub deltas {
49 4     4 1 16 my $self = shift;
50 4         30 my %params = @_;
51 4         17 my ($got, $convert, $seen) = @params{qw/got convert seen/};
52              
53 4         7 my $in = $self->{+INPUT};
54 4         12 my $in_type = rtype($in);
55 4         15 my $got_type = rtype($got);
56            
57 4         16 my $check = $convert->($$in);
58              
59 4         42 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__