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 166     166   1091 use strict;
  166         335  
  166         4580  
3 166     166   815 use warnings;
  166         333  
  166         4216  
4              
5 166     166   794 use base 'Test2::Compare::Base';
  166         366  
  166         19214  
6              
7             our $VERSION = '0.000153';
8              
9 166     166   1153 use Test2::Util::HashBase qw/input/;
  166         353  
  166         1043  
10              
11 166     166   21528 use Test2::Util::Ref qw/render_ref rtype/;
  166         368  
  166         8614  
12 166     166   1069 use Scalar::Util qw/refaddr/;
  166         379  
  166         7313  
13 166     166   1020 use Carp qw/croak/;
  166         375  
  166         54907  
14              
15             sub init {
16 4     4 0 45 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       10 unless ref $self->{+INPUT};
23              
24 4         10 $self->SUPER::init();
25             }
26              
27 0     0 1 0 sub name { '' }
28              
29             sub verify {
30 4     4 1 5 my $self = shift;
31 4         11 my %params = @_;
32 4         9 my ($got, $exists) = @params{qw/got exists/};
33              
34 4 50       6 return 0 unless $exists;
35              
36 4         8 my $in = $self->{+INPUT};
37 4 50       6 return 0 unless ref $in;
38 4 50       7 return 0 unless ref $got;
39              
40 4         8 my $in_type = rtype($in);
41 4         6 my $got_type = rtype($got);
42              
43 4 50       7 return 0 unless $in_type eq $got_type;
44              
45 4         10 return 1;
46             }
47              
48             sub deltas {
49 4     4 1 7 my $self = shift;
50 4         8 my %params = @_;
51 4         8 my ($got, $convert, $seen) = @params{qw/got convert seen/};
52              
53 4         14 my $in = $self->{+INPUT};
54 4         10 my $in_type = rtype($in);
55 4         8 my $got_type = rtype($got);
56            
57 4         10 my $check = $convert->($$in);
58              
59 4         23 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__