File Coverage

blib/lib/Test/Deep/Regexp.pm
Criterion Covered Total %
statement 43 47 91.4
branch 14 16 87.5
condition 2 2 100.0
subroutine 9 10 90.0
pod 0 6 0.0
total 68 81 83.9


line stmt bran cond sub pod time code
1 5     5   35 use strict;
  5         12  
  5         162  
2 5     5   25 use warnings;
  5         11  
  5         200  
3              
4             package Test::Deep::Regexp 1.202;
5              
6 5     5   1566 use Test::Deep::Cmp;
  5         11  
  5         22  
7 5     5   2090 use Test::Deep::RegexpMatches;
  5         14  
  5         39  
8              
9             sub init
10             {
11 29     29 0 72 my $self = shift;
12              
13 29         45 my $val = shift;
14              
15 29 100       202 $val = ref $val ? $val : qr/$val/;
16              
17 29         344 $self->{val} = $val;
18              
19 29 100       115 if (my $matches = shift)
20             {
21 5         21 $self->{matches} = Test::Deep::regexpmatches($matches, $val);
22              
23 5   100     25 $self->{flags} = shift || "";
24             }
25             }
26              
27             sub descend
28             {
29 37     37 0 58 my $self = shift;
30 37         58 my $got = shift;
31              
32 37         64 my $re = $self->{val};
33 37 100       90 if (my $match_exp = $self->{matches})
34             {
35 5         34 my $flags = $self->{flags};
36 5         10 my @match_got;
37 5 100       17 if ($flags eq "g")
38             {
39 4         51 @match_got = $got =~ /$re/g;
40             }
41             else
42             {
43 1         8 @match_got = $got =~ /$re/;
44             }
45              
46 5 50       30 if (@match_got)
47             {
48 5         25 return Test::Deep::descend(\@match_got, $match_exp);
49             }
50             else
51             {
52 0         0 return 0;
53             }
54             }
55             else
56             {
57 32 100       236 return ($got =~ $re) ? 1 : 0;
58             }
59             }
60              
61             sub diag_message
62             {
63 7     7 0 13 my $self = shift;
64              
65 7         13 my $where = shift;
66              
67 7         24 return "Using Regexp on $where";
68             }
69              
70             sub render_stack1
71             {
72 0     0 0 0 my $self = shift;
73              
74 0         0 my $stack = shift;
75 0         0 return "($stack =~ $self->{regex})";
76             }
77              
78             sub renderExp
79             {
80 8     8 0 19 my $self = shift;
81              
82 8         49 return "$self->{val}";
83             }
84              
85             sub renderGot
86             {
87 7     7 0 28 my $self = shift;
88 7         14 my $got = shift;
89              
90 7 100       31 if (defined (my $class = Scalar::Util::blessed($got)))
91             {
92 1         4 my $ostr = qq{$got};
93 1 50       10 if ($ostr ne overload::StrVal($got))
94             {
95 1         14 return qq{'$ostr' (instance of $class)};
96             }
97             }
98              
99 6         21 return Test::Deep::render_val($got);
100             }
101              
102             1;
103              
104             __END__