Initial Commit
This commit is contained in:
47
database/perl/lib/Test/Deep/RegexpOnly.pm
Normal file
47
database/perl/lib/Test/Deep/RegexpOnly.pm
Normal file
@@ -0,0 +1,47 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Test::Deep::RegexpOnly;
|
||||
|
||||
use Test::Deep::Cmp;
|
||||
|
||||
use Scalar::Util qw( blessed );
|
||||
|
||||
sub init
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $val = shift;
|
||||
|
||||
$val = ref $val ? $val : qr/$val/;
|
||||
|
||||
$self->{val} = $val;
|
||||
}
|
||||
|
||||
sub descend
|
||||
{
|
||||
my $self = shift;
|
||||
my $got = shift;
|
||||
|
||||
my $re = $self->{val};
|
||||
|
||||
return $got =~ $self->{val} ? 1 : 0;
|
||||
}
|
||||
|
||||
sub diag_message
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $where = shift;
|
||||
|
||||
return "Using Regexp on $where";
|
||||
}
|
||||
|
||||
sub renderExp
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return "$self->{val}";
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user