diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Test/Deep/Regexp.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Test/Deep/Regexp.pm | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Test/Deep/Regexp.pm b/Master/tlpkg/tlperl.straw/lib/Test/Deep/Regexp.pm new file mode 100755 index 00000000000..3f4b9e2bfd1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Test/Deep/Regexp.pm @@ -0,0 +1,85 @@ +use strict; +use warnings; + +package Test::Deep::Regexp; + +use Test::Deep::Cmp; +use Test::Deep::RegexpMatches; + +sub init +{ + my $self = shift; + + my $val = shift; + + $val = ref $val ? $val : qr/$val/; + + $self->{val} = $val; + + if (my $matches = shift) + { + $self->{matches} = Test::Deep::regexpmatches($matches, $val); + + $self->{flags} = shift || ""; + } +} + +sub descend +{ + my $self = shift; + my $got = shift; + + my $re = $self->{val}; + if (my $match_exp = $self->{matches}) + { + my $flags = $self->{flags}; + my @match_got; + if ($flags eq "g") + { + @match_got = $got =~ /$re/g; + } + else + { + @match_got = $got =~ /$re/; + } + + if (@match_got) + { + return Test::Deep::descend(\@match_got, $match_exp); + } + else + { + return 0; + } + } + else + { + return ($got =~ $re) ? 1 : 0; + } +} + +sub diag_message +{ + my $self = shift; + + my $where = shift; + + return "Using Regexp on $where"; +} + +sub render_stack1 +{ + my $self = shift; + + my $stack = shift; + return "($stack =~ $self->{regex})"; +} + +sub renderExp +{ + my $self = shift; + + return "$self->{val}"; +} + +1; |