Commit | Line | Data |
b45f050a |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | unshift @INC, '../lib'; |
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 | |
16 | my $marker1 = "<HERE<"; |
17 | my $marker2 = " <<<HERE<<< "; |
18 | |
19 | ## |
20 | ## Key-value pairs of code/error of code that should have fatal errors. |
21 | ## |
22 | my @death = |
23 | ( |
24 | '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions at {#} mark in regex m/[[=foo=]{#}]/', |
25 | |
26 | '/(?<= .*)/' => 'Variable length lookbehind not implemented at {#} mark in regex m/(?<= .*){#}/', |
27 | |
28 | '/(?<= x{10000})/' => 'Lookbehind longer than 255 not implemented at {#} mark in regex m/(?<= x{10000}){#}/', |
29 | |
30 | '/(?@)/' => 'Sequence (?@...) not implemented at {#} mark in regex m/(?@{#})/', |
31 | |
32 | '/(?{ 1/' => 'Sequence (?{...}) not terminated or not {}-balanced at {#} mark in regex m/(?{{#} 1/', |
33 | |
34 | '/(?(1x))/' => 'Switch condition not recognized at {#} mark in regex m/(?(1x{#}))/', |
35 | |
36 | '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches at {#} mark in regex m/(?(1)x|y|{#}z)/', |
37 | |
38 | '/(?(x)y|x)/' => 'Unknown switch condition (?(x) at {#} mark in regex m/(?({#}x)y|x)/', |
39 | |
40 | '/(?/' => 'Sequence (? incomplete at {#} mark in regex m/(?{#}/', |
41 | |
42 | '/(?;x/' => 'Sequence (?;...) not recognized at {#} mark in regex m/(?;{#}x/', |
43 | '/(?<;x/' => 'Sequence (?<;...) not recognized at {#} mark in regex m/(?<;{#}x/', |
44 | |
45 | '/((x)/' => 'Unmatched ( at {#} mark in regex m/({#}(x)/', |
46 | |
47 | '/x{99999}/' => 'Quantifier in {,} bigger than 32766 at {#} mark in regex m/x{{#}99999}/', |
48 | |
49 | '/x{3,1}/' => 'Can\'t do {n,m} with n > m at {#} mark in regex m/x{3,1}{#}/', |
50 | |
51 | '/x**/' => 'Nested quantifiers at {#} mark in regex m/x**{#}/', |
52 | |
53 | '/x[/' => 'Unmatched [ at {#} mark in regex m/x[{#}/', |
54 | |
55 | '/*/', => 'Quantifier follows nothing at {#} mark in regex m/*{#}/', |
56 | |
57 | '/\p{x/' => 'Missing right brace on \p{} at {#} mark in regex m/\p{{#}x/', |
58 | |
59 | 'use utf8; /[\p{x]/' => 'Missing right brace on \p{} at {#} mark in regex m/[\p{{#}x]/', |
60 | |
61 | '/(x)\2/' => 'Reference to nonexistent group at {#} mark in regex m/(x)\2{#}/', |
62 | |
63 | 'my $m = chr(92); $m =~ $m', => 'Trailing \ in regex m/\/', |
64 | |
65 | '/\x{1/' => 'Missing right brace on \x{} at {#} mark in regex m/\x{{#}1/', |
66 | |
67 | 'use utf8; /[\x{X]/' => 'Missing right brace on \x{} at {#} mark in regex m/[\x{{#}X]/', |
68 | |
69 | '/\x{x}/' => 'Can\'t use \x{} without \'use utf8\' declaration at {#} mark in regex m/\x{x}{#}/', |
70 | |
71 | '/[[:barf:]]/' => 'POSIX class [:barf:] unknown at {#} mark in regex m/[[:barf:]{#}]/', |
72 | |
73 | '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions at {#} mark in regex m/[[=barf=]{#}]/', |
74 | |
75 | '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions at {#} mark in regex m/[[.barf.]{#}]/', |
76 | |
77 | '/[z-a]/' => 'Invalid [] range "z-a" at {#} mark in regex m/[z-a{#}]/', |
78 | ); |
79 | |
80 | ## |
81 | ## Key-value pairs of code/error of code that should have non-fatal warnings. |
82 | ## |
83 | @warning = ( |
84 | "m/(?p{ 'a' })/" => "(?p{}) is deprecated - use (??{}) at {#} mark in regex m/(?p{#}{ 'a' })/", |
85 | |
86 | 'm/\b*/' => '\b* matches null string many times at {#} mark in regex m/\b*{#}/', |
87 | |
88 | 'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes at {#} mark in regex m/[:blank:]{#}/', |
89 | |
90 | "m'[\\y]'" => 'Unrecognized escape \y in character class passed through at {#} mark in regex m/[\y{#}]/', |
91 | |
92 | 'm/[a-\d]/' => 'False [] range "a-\d" at {#} mark in regex m/[a-\d{#}]/', |
93 | 'm/[\w-x]/' => 'False [] range "\w-" at {#} mark in regex m/[\w-{#}x]/', |
94 | "m'\\y'" => 'Unrecognized escape \y passed through at {#} mark in regex m/\y{#}/', |
95 | ); |
96 | |
97 | my $total = (@death + @warning)/2; |
98 | |
99 | print "1..$total\n"; |
100 | |
101 | my $count = 0; |
102 | |
103 | while (@death) |
104 | { |
105 | $count++; |
106 | my $regex = shift @death; |
107 | my $result = shift @death; |
108 | |
109 | undef $@; |
110 | $_ = "x"; |
111 | eval $regex; |
112 | if (not $@) { |
113 | if ($debug) { |
114 | print "oops, $regex didn't die\n" |
115 | } else { |
116 | print "not ok $count\n"; |
117 | } |
118 | next; |
119 | } |
120 | chomp $@; |
121 | $@ =~ s/ at \(.*?\) line \d+\.$//; |
122 | $result =~ s/{\#}/$marker1/; |
123 | $result =~ s/{\#}/$marker2/; |
124 | if ($@ ne $result) { |
125 | if ($debug) { |
126 | print "For $regex, expected:\n $result\nGot:\n $@\n\n"; |
127 | } else { |
128 | print "not ok $count\n"; |
129 | } |
130 | next; |
131 | } |
132 | print "ok $count\n"; |
133 | } |
134 | |
135 | |
136 | our $warning; |
137 | $SIG{__WARN__} = sub { $warning = shift }; |
138 | |
139 | while (@warning) |
140 | { |
141 | $count++; |
142 | my $regex = shift @warning; |
143 | my $result = shift @warning; |
144 | |
145 | undef $warning; |
146 | $_ = "x"; |
147 | eval $regex; |
148 | |
149 | if ($@) |
150 | { |
151 | if ($debug) { |
152 | print "oops, $regex died with:\n\t$@\n"; |
153 | } else { |
154 | print "not ok $count\n"; |
155 | } |
156 | next; |
157 | } |
158 | |
159 | if (not $warning) |
160 | { |
161 | if ($debug) { |
162 | print "oops, $regex didn't generate a warning\n"; |
163 | } else { |
164 | print "not ok $count\n"; |
165 | } |
166 | next; |
167 | } |
168 | chomp $warning; |
169 | $warning =~ s/ at \(.*?\) line \d+\.$//; |
170 | $result =~ s/{\#}/$marker1/; |
171 | $result =~ s/{\#}/$marker2/; |
172 | if ($warning ne $result) |
173 | { |
174 | if ($debug) { |
175 | print "For $regex, expected:\n $result\nGot:\n $warning\n\n"; |
176 | } else { |
177 | print "not ok $count\n"; |
178 | } |
179 | next; |
180 | } |
181 | print "ok $count\n"; |
182 | } |
183 | |
184 | |
185 | |