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
117
118
119
120
|
#!/usr/bin/perl
use strict;
use lib qw {blib/lib};
use Regexp::Common qw /RE_zip_Italy/;
use t::Common qw /run_new_tests cross d pd dd a/;
# use warnings;
sub create_parts;
my $italy = $RE {zip} {Italy};
my $yes_prefix = $RE {zip} {Italy} {-prefix => 'yes'};
my $no_prefix = $RE {zip} {Italy} {-prefix => 'no'};
my $iso_prefix = $RE {zip} {Italy} {-country => 'iso'};
my $cept_prefix = $RE {zip} {Italy} {-country => 'cept'};
my $own_prefix = $RE {zip} {Italy} {-country => 'it'};
use constant FAIL => 5;
my @base = ([0, pd], [0, pd], [0, pd], [0, pd], [0, pd]);
my $zips = [cross @base];
my @long = map {dd 6 => 10} 1 .. FAIL;
my @short = map {dd 1 => 4} 1 .. FAIL;
my @letter = map {my $z = dd 5; substr $z, rand (5), 1, a; $z} 1 .. FAIL;
my $wrong = [@long, @short, @letter];
my %targets = (
no_prefix => {
list => $zips,
query => sub {join "" => @_},
wanted => sub {$_, undef, join ("" => @_), @_},
},
iso_prefix => {
list => $zips,
query => sub {"IT-" . join "" => @_},
wanted => sub {$_, "IT", join ("" => @_), @_},
},
cept_prefix => {
list => $zips,
query => sub {"I-" . join "" => @_},
wanted => sub {$_, "I", join ("" => @_), @_},
},
own_prefix => {
list => $zips,
query => sub {"it-" . join "" => @_},
wanted => sub {$_, "it", join ("" => @_), @_},
},
wrong1 => {
list => $wrong,
query => sub {$_ [0]},
},
wrong2 => {
list => $wrong,
query => sub {"IT-" . $_ [0]},
},
wrong3 => {
list => $wrong,
query => sub {"I-" . $_ [0]},
},
wrong4 => {
list => $zips,
query => sub {"IT " . join "" => @_},
},
);
my @wrongs = qw /wrong1 wrong2 wrong3 wrong4/;
my @tests = (
{ name => 'basic',
regex => $italy,
pass => [qw /no_prefix iso_prefix cept_prefix/],
fail => [qw /own_prefix/, @wrongs],
sub => \&RE_zip_Italy,
},
{ name => 'yes_prefix',
regex => $yes_prefix,
pass => [qw /iso_prefix cept_prefix/],
fail => [qw /no_prefix own_prefix/, @wrongs],
sub => \&RE_zip_Italy,
sub_args => [-prefix => 'yes'],
},
{ name => 'no_prefix',
regex => $no_prefix,
pass => [qw /no_prefix/],
fail => [qw /iso_prefix cept_prefix own_prefix/, @wrongs],
sub => \&RE_zip_Italy,
sub_args => [-prefix => 'no'],
},
{ name => 'iso_prefix',
regex => $iso_prefix,
pass => [qw /no_prefix iso_prefix/],
fail => [qw /cept_prefix own_prefix/, @wrongs],
sub => \&RE_zip_Italy,
sub_args => [-country => 'iso'],
},
{ name => 'cept_prefix',
regex => $cept_prefix,
pass => [qw /no_prefix cept_prefix/],
fail => [qw /iso_prefix own_prefix/, @wrongs],
sub => \&RE_zip_Italy,
sub_args => [-country => 'cept'],
},
{ name => 'own_prefix',
regex => $own_prefix,
pass => [qw /no_prefix own_prefix/],
fail => [qw /iso_prefix cept_prefix/, @wrongs],
sub => \&RE_zip_Italy,
sub_args => [-country => 'it'],
},
);
run_new_tests tests => \@tests,
targets => \%targets,
version_from => 'Regexp::Common::zip',
;
__END__
|
