Commit | Line | Data |
b45f050a |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
b45f050a |
6 | } |
7 | |
8 | my $debug = 1; |
9 | |
10 | ## |
11 | ## If the markers used are changed (search for "MARKER1" in regcomp.c), |
12 | ## update only these two variables, and leave the {#} in the @death/@warning |
13 | ## arrays below. The {#} is a meta-marker -- it marks where the marker should |
14 | ## go. |
15 | |
7253e4e3 |
16 | my $marker1 = "<-- HERE"; |
17 | my $marker2 = " <-- HERE "; |
b45f050a |
18 | |
19 | ## |
20 | ## Key-value pairs of code/error of code that should have fatal errors. |
21 | ## |
69f2e79d |
22 | |
23 | eval 'use Config'; # assume defaults if fail |
24 | our %Config; |
25 | my $inf_m1 = ($Config{reg_infty} || 32767) - 1; |
26 | my $inf_p1 = $inf_m1 + 2; |
b45f050a |
27 | my @death = |
28 | ( |
7253e4e3 |
29 | '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=foo=]{#}]/', |
b45f050a |
30 | |
58e23c8d |
31 | '/(?<= .*)/' => 'Variable length lookbehind not implemented in regex m/(?<= .*)/', |
b45f050a |
32 | |
58e23c8d |
33 | '/(?<= x{1000})/' => 'Lookbehind longer than 255 not implemented in regex m/(?<= x{1000})/', |
b45f050a |
34 | |
7253e4e3 |
35 | '/(?@)/' => 'Sequence (?@...) not implemented in regex; marked by {#} in m/(?@{#})/', |
b45f050a |
36 | |
7253e4e3 |
37 | '/(?{ 1/' => 'Sequence (?{...}) not terminated or not {}-balanced in regex; marked by {#} in m/(?{{#} 1/', |
b45f050a |
38 | |
7253e4e3 |
39 | '/(?(1x))/' => 'Switch condition not recognized in regex; marked by {#} in m/(?(1x{#}))/', |
b45f050a |
40 | |
7253e4e3 |
41 | '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches in regex; marked by {#} in m/(?(1)x|y|{#}z)/', |
b45f050a |
42 | |
7253e4e3 |
43 | '/(?(x)y|x)/' => 'Unknown switch condition (?(x) in regex; marked by {#} in m/(?({#}x)y|x)/', |
b45f050a |
44 | |
7253e4e3 |
45 | '/(?/' => 'Sequence (? incomplete in regex; marked by {#} in m/(?{#}/', |
b45f050a |
46 | |
7253e4e3 |
47 | '/(?;x/' => 'Sequence (?;...) not recognized in regex; marked by {#} in m/(?;{#}x/', |
48 | '/(?<;x/' => 'Sequence (?<;...) not recognized in regex; marked by {#} in m/(?<;{#}x/', |
b45f050a |
49 | |
cc74c5bd |
50 | '/(?\ix/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}ix/', |
51 | '/(?\mx/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}mx/', |
52 | '/(?\:x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}:x/', |
53 | '/(?\=x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}=x/', |
54 | '/(?\!x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}!x/', |
55 | '/(?\<=x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}<=x/', |
56 | '/(?\<!x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}<!x/', |
57 | '/(?\>x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}>x/', |
58 | |
7253e4e3 |
59 | '/((x)/' => 'Unmatched ( in regex; marked by {#} in m/({#}(x)/', |
b45f050a |
60 | |
7253e4e3 |
61 | "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 in regex; marked by {#} in m/x{{#}$inf_p1}/", |
b45f050a |
62 | |
7253e4e3 |
63 | '/x{3,1}/' => 'Can\'t do {n,m} with n > m in regex; marked by {#} in m/x{3,1}{#}/', |
b45f050a |
64 | |
7253e4e3 |
65 | '/x**/' => 'Nested quantifiers in regex; marked by {#} in m/x**{#}/', |
b45f050a |
66 | |
7253e4e3 |
67 | '/x[/' => 'Unmatched [ in regex; marked by {#} in m/x[{#}/', |
b45f050a |
68 | |
7253e4e3 |
69 | '/*/', => 'Quantifier follows nothing in regex; marked by {#} in m/*{#}/', |
b45f050a |
70 | |
7253e4e3 |
71 | '/\p{x/' => 'Missing right brace on \p{} in regex; marked by {#} in m/\p{{#}x/', |
b45f050a |
72 | |
169da838 |
73 | '/[\p{x]/' => 'Missing right brace on \p{} in regex; marked by {#} in m/[\p{{#}x]/', |
b45f050a |
74 | |
7253e4e3 |
75 | '/(x)\2/' => 'Reference to nonexistent group in regex; marked by {#} in m/(x)\2{#}/', |
b45f050a |
76 | |
40809656 |
77 | 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/', |
b45f050a |
78 | |
7253e4e3 |
79 | '/\x{1/' => 'Missing right brace on \x{} in regex; marked by {#} in m/\x{{#}1/', |
b45f050a |
80 | |
169da838 |
81 | '/[\x{X]/' => 'Missing right brace on \x{} in regex; marked by {#} in m/[\x{{#}X]/', |
b45f050a |
82 | |
7253e4e3 |
83 | '/[[:barf:]]/' => 'POSIX class [:barf:] unknown in regex; marked by {#} in m/[[:barf:]{#}]/', |
b45f050a |
84 | |
7253e4e3 |
85 | '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=barf=]{#}]/', |
b45f050a |
86 | |
7253e4e3 |
87 | '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions in regex; marked by {#} in m/[[.barf.]{#}]/', |
b45f050a |
88 | |
7253e4e3 |
89 | '/[z-a]/' => 'Invalid [] range "z-a" in regex; marked by {#} in m/[z-a{#}]/', |
5528c7ba |
90 | |
91 | '/\p/' => 'Empty \p{} in regex; marked by {#} in m/\p{#}/', |
92 | |
93 | '/\P{}/' => 'Empty \P{} in regex; marked by {#} in m/\P{{#}}/', |
b45f050a |
94 | ); |
95 | |
96 | ## |
97 | ## Key-value pairs of code/error of code that should have non-fatal warnings. |
98 | ## |
99 | @warning = ( |
7253e4e3 |
100 | 'm/\b*/' => '\b* matches null string many times in regex; marked by {#} in m/\b*{#}/', |
b45f050a |
101 | |
7253e4e3 |
102 | 'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes in regex; marked by {#} in m/[:blank:]{#}/', |
b45f050a |
103 | |
7253e4e3 |
104 | "m'[\\y]'" => 'Unrecognized escape \y in character class passed through in regex; marked by {#} in m/[\y{#}]/', |
b45f050a |
105 | |
7253e4e3 |
106 | 'm/[a-\d]/' => 'False [] range "a-\d" in regex; marked by {#} in m/[a-\d{#}]/', |
107 | 'm/[\w-x]/' => 'False [] range "\w-" in regex; marked by {#} in m/[\w-{#}x]/', |
f81125e2 |
108 | 'm/[a-\pM]/' => 'False [] range "a-\pM" in regex; marked by {#} in m/[a-\pM{#}]/', |
109 | 'm/[\pM-x]/' => 'False [] range "\pM-" in regex; marked by {#} in m/[\pM-{#}x]/', |
7253e4e3 |
110 | "m'\\y'" => 'Unrecognized escape \y passed through in regex; marked by {#} in m/\y{#}/', |
b45f050a |
111 | ); |
112 | |
113 | my $total = (@death + @warning)/2; |
114 | |
40809656 |
115 | # utf8 is a noop on EBCDIC platforms, it is not fatal |
116 | my $Is_EBCDIC = (ord('A') == 193); |
117 | if ($Is_EBCDIC) { |
118 | my @utf8_death = grep(/utf8/, @death); |
7387eed8 |
119 | $total = $total - @utf8_death; |
40809656 |
120 | } |
121 | |
b45f050a |
122 | print "1..$total\n"; |
123 | |
124 | my $count = 0; |
125 | |
126 | while (@death) |
127 | { |
b45f050a |
128 | my $regex = shift @death; |
129 | my $result = shift @death; |
40809656 |
130 | # skip the utf8 test on EBCDIC since they do not die |
131 | next if ($Is_EBCDIC && $regex =~ /utf8/); |
132 | $count++; |
b45f050a |
133 | |
b45f050a |
134 | $_ = "x"; |
135 | eval $regex; |
136 | if (not $@) { |
69f2e79d |
137 | print "# oops, $regex didn't die\nnot ok $count\n"; |
b45f050a |
138 | next; |
139 | } |
140 | chomp $@; |
b45f050a |
141 | $result =~ s/{\#}/$marker1/; |
142 | $result =~ s/{\#}/$marker2/; |
197cf9b9 |
143 | $result .= " at "; |
69f2e79d |
144 | if ($@ !~ /^\Q$result/) { |
145 | print "# For $regex, expected:\n# $result\n# Got:\n# $@\n#\nnot "; |
b45f050a |
146 | } |
d8176a88 |
147 | print "ok $count - $regex\n"; |
b45f050a |
148 | } |
149 | |
150 | |
151 | our $warning; |
152 | $SIG{__WARN__} = sub { $warning = shift }; |
153 | |
154 | while (@warning) |
155 | { |
156 | $count++; |
157 | my $regex = shift @warning; |
158 | my $result = shift @warning; |
159 | |
160 | undef $warning; |
161 | $_ = "x"; |
162 | eval $regex; |
163 | |
164 | if ($@) |
165 | { |
69f2e79d |
166 | print "# oops, $regex died with:\n#\t$@#\nnot ok $count\n"; |
b45f050a |
167 | next; |
168 | } |
169 | |
170 | if (not $warning) |
171 | { |
69f2e79d |
172 | print "# oops, $regex didn't generate a warning\nnot ok $count\n"; |
b45f050a |
173 | next; |
174 | } |
b45f050a |
175 | $result =~ s/{\#}/$marker1/; |
176 | $result =~ s/{\#}/$marker2/; |
197cf9b9 |
177 | $result .= " at "; |
69f2e79d |
178 | if ($warning !~ /^\Q$result/) |
b45f050a |
179 | { |
69f2e79d |
180 | print <<"EOM"; |
181 | # For $regex, expected: |
182 | # $result |
183 | # Got: |
184 | # $warning |
185 | # |
186 | not ok $count |
187 | EOM |
b45f050a |
188 | next; |
189 | } |
d8176a88 |
190 | print "ok $count - $regex\n"; |
b45f050a |
191 | } |
192 | |
193 | |
194 | |