1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
#!/usr/bin/perl
use strict;
use lib qw {blib/lib}, ".";
use Regexp::Common;
use t::Common qw /run_new_tests cross criss_cross dd pdd/;
$^W = 1;
my $ssn = $RE {SEN} {USA} {SSN};
my $space = $ssn -> {-sep => ' '};
my $empty = $ssn -> {-sep => ''};
use constant PASS => 4;
use constant FAIL => 3;
my $areas = [ "001", map {pdd 3} 1 .. PASS];
my $groups = [ "01", map {pdd 2} 1 .. PASS];
my $serials = ["0001", map {pdd 4} 1 .. PASS];
my $bad_a = [ "000", "", dd (1), dd (2), dd (4), dd (5, 10)];
my $bad_g = [ "00", "", dd (1), dd (3), dd (4), dd (5, 10)];
my $bad_s = ["0000", "", dd (1), dd (2), dd (3), dd (5, 10)];
my $ssns = [cross $areas, $groups, $serials];
my $wrong = [criss_cross [[@$areas [0 .. FAIL - 1]],
[@$groups [0 .. FAIL - 1]],
[@$serials [0 .. FAIL - 1]]],
[$bad_a, $bad_g, $bad_s]];
my %targets = (
ssn => {
list => $ssns,
query => sub {join "-" => @_},
wanted => sub {$_ => @_},
},
space => {
list => $ssns,
query => sub {join " " => @_},
wanted => sub {$_ => @_},
},
empty => {
list => $ssns,
query => sub {join "" => @_},
wanted => sub {$_ => @_},
},
wrong1 => {
list => $wrong,
query => sub {join "-" => @_},
},
wrong2 => {
list => $wrong,
query => sub {join " " => @_},
},
);
my @wrongs = qw /wrong1 wrong2/;
my @tests = (
{ name => 'basic',
regex => $ssn,
pass => [qw /ssn/],
fail => [qw /empty space/, @wrongs],
},
{ name => 'space',
regex => $space,
pass => [qw /space/],
fail => [qw /empty ssn/, @wrongs],
},
{ name => 'empty',
regex => $empty,
pass => [qw /empty/],
fail => [qw /ssn space/, @wrongs],
},
);
run_new_tests tests => \@tests,
targets => \%targets,
version_from => 'Regexp::Common::SEN',
;
__END__
|
