File Coverage

lib/Test/Easy/DeepEqual.pm
Criterion Covered Total %
statement 30 92 32.6
branch 0 38 0.0
condition 0 18 0.0
subroutine 10 22 45.4
pod 0 2 0.0
total 40 172 23.2


line stmt bran cond sub pod time code
1 6     6   28 use strict;
  6         11  
  6         202  
2 6     6   27 use warnings;
  6         9  
  6         187  
3             package Test::Easy::DeepEqual;
4 6     6   27 use base qw(Exporter);
  6         7  
  6         372  
5              
6 6     6   28 use Carp ();
  6         13  
  6         103  
7 6     6   5665 use Data::Denter ();
  6         42366  
  6         200  
8 6     6   69 use Data::Denter ();
  6         12  
  6         95  
9 6     6   6655 use Data::Difflet;
  6         167045  
  6         220  
10 6     6   64 use Scalar::Util ();
  6         13  
  6         103  
11 6     6   3782 use Test::Easy::equivalence;
  6         17  
  6         236  
12 6     6   34 use Test::More ();
  6         11  
  6         6170  
13              
14             our @EXPORT = qw(deep_ok deep_equal);
15              
16             sub deep_ok ($$;$) {
17 0     0 0   my ($got, $exp, $message) = @_;
18              
19 0           local $Test::Builder::Level = $Test::Builder::Level + 1;
20 0 0         Test::More::ok( deep_equal($got, $exp), $message ) || do {
21 0           my $dump_got = Data::Denter::Denter($got);
22 0           my $dump_exp = Data::Denter::Denter($exp);
23              
24 0           Test::More::diag '$GOT';
25 0           Test::More::diag $dump_got;
26 0           Test::More::diag '$EXPECTED';
27 0           Test::More::diag $dump_exp;
28 0           Test::More::diag '$DIFFLET';
29 0           Test::More::diag(Data::Difflet->new->compare($got, $exp));
30             };
31             }
32              
33             sub deep_equal {
34 0 0   0 0   Carp::confess "must have only two things to deep_equal" if @_ != 2;
35              
36 0 0         return 1 if _undefs(@_);
37 0 0         return 0 unless _same_type(@_);
38 0 0 0       return 1 if _hashrefs(@_) && _same_hashrefs(@_);
39 0 0 0       return 1 if _arrayrefs(@_) && _same_arrayrefs(@_);
40 0 0         return 1 if _same_values(@_); # note, not 'if _scalars(@_) && _same_values(@_)'
41 0 0         return 1 if _regex_match(@_);
42 0           return 0;
43             }
44              
45 0     0     sub _undefs { return 2 == grep { ! defined } @_ }
  0            
46 0     0     sub _hashrefs { return 2 == grep { ref($_) eq 'HASH' } @_ }
  0            
47 0     0     sub _arrayrefs { return 2 == grep { ref($_) eq 'ARRAY' } @_ }
  0            
48              
49             # check the refs of $got and $exp; they must match, or $got must be a simple scalar and $exp must be a checker object.
50             sub _same_type {
51 0     0     my ($got, $exp) = @_;
52              
53 0 0         return 1 if _undefs(@_);
54 0 0         return 1 if ref($got) eq ref($exp);
55 0 0 0       return 1 if ! ref($got) && _is_a_checker($exp);
56 0 0 0       if (! ref($got) && ref($exp) eq 'Regexp') {
57 0           $DB::single = 1;1;
  0            
58 0           return 1;
59             }
60 0           Carp::cluck "a ${\ref($got)} is not a ${\ref($exp)}!\n";
  0            
  0            
61 0           return 0;
62             }
63              
64             sub _same_hashrefs {
65 0     0     my ($got, $exp) = @_;
66              
67             # if their keys aren't the same there's no point checking further
68             # ...but really we should run the checker objects as mutators on $exp
69             # so the real failure is apparent
70 0 0         return 0 unless scalar keys %$got == scalar keys %$exp;
71              
72             # not 'each': it would reset the hash's iterator on a potentially weird caller
73 0           foreach my $k (keys %$exp) {
74 0 0         return 0 unless exists $got->{$k};
75 0 0         return 0 unless deep_equal($got->{$k}, $exp->{$k});
76             }
77              
78             # make sure there's nothing extra in $got that we didn't $exp'ect to see.
79 0           return 0 == grep { ! exists $exp->{$_} } keys %$got;
  0            
80             }
81              
82             sub _same_arrayrefs {
83 0     0     my ($got, $exp) = @_;
84              
85 0 0         return 0 unless $#$got == $#$exp;
86              
87 0           for (my $i = 0; $i < @$exp; $i++) {
88 0 0         return 0 unless deep_equal($got->[$i], $exp->[$i]);
89             }
90              
91 0           return 1;
92             }
93              
94             sub _is_a_checker {
95 0     0     my ($exp) = @_;
96 0           my $ref = ref($exp);
97 0   0       return $ref && Scalar::Util::blessed($exp) && UNIVERSAL::can($exp, 'check_value');
98             }
99              
100             sub _same_values {
101 0     0     my ($got, $exp) = @_;
102 0           my ($ref_got, $ref_exp) = map { ref } $got, $exp;
  0            
103             my $checker = _is_a_checker($exp)
104             ? $exp
105             : Test::Easy::equivalence->new(
106             test => sub {
107 0     0     my ($got) = @_;
108 0           return "$got" eq "$exp";
109             },
110 0 0         );
111 0           return $checker->check_value($got);
112             }
113              
114             sub _regex_match {
115 0     0     my ($got, $exp) = @_;
116 0 0 0       return 0 if ref($got) || ref($exp) ne 'Regexp';
117 0           return $got =~ $exp;
118             }
119              
120             1;