root/branches/release-40/t/lib/Test/Deep/Regexp.pm @ 2583

Revision 2583, 1.0 kB (checked in by mpaschal, 18 months ago)

Add Test::Deep to t/lib, since we already use it in driver-tests.pl
BugzID: 79953

Line 
1use strict;
2use warnings;
3
4package Test::Deep::Regexp;
5
6use Test::Deep::Cmp;
7use Test::Deep::RegexpMatches;
8
9sub init
10{
11        my $self = shift;
12
13        my $val = shift;
14
15        $val = ref $val ? $val : qr/$val/;
16
17        $self->{val} = $val;
18
19        if (my $matches = shift)
20        {
21                $self->{matches} = Test::Deep::regexpmatches($matches, $val);
22               
23                $self->{flags} = shift || "";
24        }
25}
26
27sub descend
28{
29        my $self = shift;
30        my $got = shift;
31
32        my $re = $self->{val};
33        if (my $match_exp = $self->{matches})
34        {
35                my $flags = $self->{flags};
36                my @match_got;
37                if ($flags eq "g")
38                {
39                        @match_got = $got =~ /$re/g;
40                }
41                else
42                {
43                        @match_got = $got =~ /$re/;
44                }
45
46                if (@match_got)
47                {
48                        return Test::Deep::descend(\@match_got, $match_exp);
49                }
50                else
51                {
52                        return 0;
53                }
54        }
55        else
56        {
57                return ($got =~ $re) ? 1 : 0;
58        }
59}
60
61sub diag_message
62{
63        my $self = shift;
64
65        my $where = shift;
66
67        return "Using Regexp on $where";
68}
69
70sub render_stack1
71{
72        my $self = shift;
73
74        my $stack = shift;
75        return "($stack =~ $self->{regex})";
76}
77
78sub renderExp
79{
80        my $self = shift;
81
82        return "$self->{val}";
83}
84
851;
Note: See TracBrowser for help on using the browser.