File Coverage

blib/lib/Test/HexDifferences.pm
Criterion Covered Total %
statement 37 37 100.0
branch 18 22 81.8
condition 10 18 55.5
subroutine 8 8 100.0
pod 2 2 100.0
total 75 87 86.2


line stmt bran cond sub pod time code
1             package Test::HexDifferences; ## no critic (TidyCode)
2            
3 2     2   40815 use strict;
  2         5  
  2         47  
4 2     2   9 use warnings;
  2         5  
  2         93  
5            
6 2         18 use Sub::Exporter -setup => {
7             exports => [
8             qw(eq_or_dump_diff dumped_eq_dump_or_diff),
9             ],
10             groups => {
11             default => [ qw(eq_or_dump_diff dumped_eq_dump_or_diff) ],
12             },
13 2     2   980 };
  2         20192  
14 2     2   926 use Test::Builder::Module;
  2         4  
  2         12  
15 2     2   816 use Test::HexDifferences::HexDump qw(hex_dump);
  2         4  
  2         12  
16 2     2   1271 use Text::Diff qw(diff);
  2         12505  
  2         623  
17            
18             our $VERSION = '1.001';
19            
20             my $builder = Test::Builder->new;
21            
22             my %diff_arg_of = (
23             STYLE => 'Table',
24             INDEX_LABEL => 'Ln',
25             FILENAME_A => 'Got',
26             FILENAME_B => 'Expected',
27             );
28            
29             sub eq_or_dump_diff ($$;$$) { ## no critic (SubroutinePrototypes)
30 4     4 1 10648 my ($got, $expected, @more) = @_;
31            
32 4 50 33     28 my $attr_ref
33             = ( @more && ref $more[0] eq 'HASH' )
34             ? shift @more
35             : ();
36 4   66     16 my $both_undefined
37             = ! defined $got
38             && ! defined $expected;
39 4   100     15 my $any_undefined
40             = ! defined $got
41             || ! defined $expected;
42 4 100 66     21 if ( $both_undefined || $any_undefined ) {
43 2   33     12 my $result
44             = $both_undefined
45             || ! $any_undefined && $got eq $expected;
46 2 100       5 $got = defined $got ? $got : 'undef';
47 2 100       6 $expected = defined $expected ? $expected : 'undef';
48 2 50       15 my $ok = $builder->ok($result, $more[0])
49             or $builder->diag(
50             diff(
51             \$got,
52             \$expected,
53             \%diff_arg_of,
54             ),
55             );
56 2         14512 return $ok;
57             }
58 2 100       15 my $ok = $builder->ok($got eq $expected, $more[0])
59             or $builder->diag(
60             diff(
61             \hex_dump($got, $attr_ref),
62             \hex_dump($expected, $attr_ref),
63             \%diff_arg_of,
64             ),
65             );
66            
67 2         1624 return $ok;
68             }
69            
70             sub dumped_eq_dump_or_diff ($$;$$) { ## no critic (SubroutinePrototypes)
71 4     4 1 7801 my ($got, $expected_dump, @more) = @_;
72            
73 4 50 33     26 my $attr_ref
74             = ( @more && ref $more[0] eq 'HASH' )
75             ? shift @more
76             : ();
77 4 100       19 $got = defined $got
78             ? hex_dump($got, $attr_ref)
79             : 'undef';
80 4 100       11 $expected_dump = defined $expected_dump
81             ? $expected_dump
82             : 'undef';
83 4 50       8 $expected_dump = defined $expected_dump ? $expected_dump : q{};
84 4 100       29 my $ok = $builder->ok($got eq $expected_dump, $more[0])
85             or $builder->diag(
86             diff(
87             \$got,
88             \$expected_dump,
89             \%diff_arg_of,
90             ),
91             );
92            
93 4         16618 return $ok;
94             }
95            
96             # $Id$
97            
98             1;
99            
100             __END__