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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#!/usr/bin/perl
use strict;
use lib qw {blib/lib};
use Regexp::Common qw /RE_zip_Norway/;
use t::Common qw /run_new_tests cross pdd dd a/;
use warnings;
my $norway = $RE {zip} {Norway};
my $yes_prefix = $RE {zip} {Norway} {-prefix => 'yes'};
my $no_prefix = $RE {zip} {Norway} {-prefix => 'no'};
my $iso_prefix = $RE {zip} {Norway} {-country => 'iso'};
my $cept_prefix = $RE {zip} {Norway} {-country => 'cept'};
my $own_prefix = $RE {zip} {Norway} {-country => 'no'};
use constant PASS => 10;
use constant FAIL => 10;
my $valid = [ '0000', '9999', map {pdd 4} 1 .. -2 + PASS];
my $short = [ '0', '999', map {dd 1 => 3} 1 .. -2 + FAIL];
my $long = ['00000', '99999', map {dd 5 => 10} 1 .. -2 + FAIL];
my $letter = [map {my $z = dd 4; substr $z, rand (4), 1, a; $z} 1 .. FAIL];
my $wrong = [@$long, @$short, @$letter];
my %targets = (
no_prefix => {
list => $valid,
wanted => sub {$_, undef, $_ [0]},
},
iso_prefix => {
list => $valid,
query => sub {"NO-" . $_ [0]},
wanted => sub {$_, "NO", $_ [0]},
},
cept_prefix => {
list => $valid,
query => sub {"N-" . $_ [0]},
wanted => sub {$_, "N", $_ [0]},
},
own_prefix => {
list => $valid,
query => sub {"no-" . $_ [0]},
wanted => sub {$_, "no", $_ [0]},
},
wrong1 => {
list => $wrong,
},
wrong2 => {
list => $wrong,
query => sub {"NO-" . $_ [0]},
},
wrong3 => {
list => $wrong,
query => sub {"N-" . $_ [0]},
},
wrong4 => {
list => $valid,
query => sub {"NO " . $_ [0]},
},
);
my @wrongs = qw /wrong1 wrong2 wrong3 wrong4/;
my @tests = (
{ name => 'basic',
regex => $norway,
sub => \&RE_zip_Norway,
pass => [qw /no_prefix iso_prefix cept_prefix/],
fail => [qw /own_prefix/, @wrongs],
},
{ name => 'yes_prefix',
regex => $yes_prefix,
sub => \&RE_zip_Norway,
sub_args => [-prefix => 'yes'],
pass => [qw /iso_prefix cept_prefix/],
fail => [qw /no_prefix own_prefix/, @wrongs],
},
{ name => 'no_prefix',
regex => $no_prefix,
sub => \&RE_zip_Norway,
sub_args => [-prefix => 'no'],
pass => [qw /no_prefix/],
fail => [qw /iso_prefix cept_prefix own_prefix/, @wrongs],
},
{ name => 'iso_prefix',
regex => $iso_prefix,
sub => \&RE_zip_Norway,
sub_args => [-country => 'iso'],
pass => [qw /no_prefix iso_prefix/],
fail => [qw /cept_prefix own_prefix/, @wrongs],
},
{ name => 'cept_prefix',
regex => $cept_prefix,
sub => \&RE_zip_Norway,
sub_args => [-country => 'cept'],
pass => [qw /no_prefix cept_prefix/],
fail => [qw /iso_prefix own_prefix/, @wrongs],
},
{ name => 'own_prefix',
regex => $own_prefix,
sub => \&RE_zip_Norway,
sub_args => [-country => 'no'],
pass => [qw /no_prefix own_prefix/],
fail => [qw /iso_prefix cept_prefix/, @wrongs],
},
);
run_new_tests tests => \@tests,
targets => \%targets,
version_from => 'Regexp::Common::zip',
;
__END__
|
