Commit | Line | Data |
---|---|---|
b45f050a JF |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
b45f050a JF |
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 RK |
16 | my $marker1 = "<-- HERE"; |
17 | my $marker2 = " <-- HERE "; | |
b45f050a JF |
18 | |
19 | ## | |
20 | ## Key-value pairs of code/error of code that should have fatal errors. | |
21 | ## | |
69f2e79d MG |
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 JF |
27 | my @death = |
28 | ( | |
7253e4e3 | 29 | '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=foo=]{#}]/', |
b45f050a | 30 | |
7253e4e3 | 31 | '/(?<= .*)/' => 'Variable length lookbehind not implemented in regex; marked by {#} in m/(?<= .*){#}/', |
b45f050a | 32 | |
7253e4e3 | 33 | '/(?<= x{1000})/' => 'Lookbehind longer than 255 not implemented in regex; marked by {#} in 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 RK |
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 | |
7253e4e3 | 50 | '/((x)/' => 'Unmatched ( in regex; marked by {#} in m/({#}(x)/', |
b45f050a | 51 | |
7253e4e3 | 52 | "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 in regex; marked by {#} in m/x{{#}$inf_p1}/", |
b45f050a | 53 | |
7253e4e3 | 54 | '/x{3,1}/' => 'Can\'t do {n,m} with n > m in regex; marked by {#} in m/x{3,1}{#}/', |
b45f050a | 55 | |
7253e4e3 | 56 | '/x**/' => 'Nested quantifiers in regex; marked by {#} in m/x**{#}/', |
b45f050a | 57 | |
7253e4e3 | 58 | '/x[/' => 'Unmatched [ in regex; marked by {#} in m/x[{#}/', |
b45f050a | 59 | |
7253e4e3 | 60 | '/*/', => 'Quantifier follows nothing in regex; marked by {#} in m/*{#}/', |
b45f050a | 61 | |
7253e4e3 | 62 | '/\p{x/' => 'Missing right brace on \p{} in regex; marked by {#} in m/\p{{#}x/', |
b45f050a | 63 | |
169da838 | 64 | '/[\p{x]/' => 'Missing right brace on \p{} in regex; marked by {#} in m/[\p{{#}x]/', |
b45f050a | 65 | |
7253e4e3 | 66 | '/(x)\2/' => 'Reference to nonexistent group in regex; marked by {#} in m/(x)\2{#}/', |
b45f050a | 67 | |
40809656 | 68 | 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/', |
b45f050a | 69 | |
7253e4e3 | 70 | '/\x{1/' => 'Missing right brace on \x{} in regex; marked by {#} in m/\x{{#}1/', |
b45f050a | 71 | |
169da838 | 72 | '/[\x{X]/' => 'Missing right brace on \x{} in regex; marked by {#} in m/[\x{{#}X]/', |
b45f050a | 73 | |
7253e4e3 | 74 | '/[[:barf:]]/' => 'POSIX class [:barf:] unknown in regex; marked by {#} in m/[[:barf:]{#}]/', |
b45f050a | 75 | |
7253e4e3 | 76 | '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=barf=]{#}]/', |
b45f050a | 77 | |
7253e4e3 | 78 | '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions in regex; marked by {#} in m/[[.barf.]{#}]/', |
b45f050a | 79 | |
7253e4e3 | 80 | '/[z-a]/' => 'Invalid [] range "z-a" in regex; marked by {#} in m/[z-a{#}]/', |
5528c7ba RGS |
81 | |
82 | '/\p/' => 'Empty \p{} in regex; marked by {#} in m/\p{#}/', | |
83 | ||
84 | '/\P{}/' => 'Empty \P{} in regex; marked by {#} in m/\P{{#}}/', | |
b45f050a JF |
85 | ); |
86 | ||
87 | ## | |
88 | ## Key-value pairs of code/error of code that should have non-fatal warnings. | |
89 | ## | |
90 | @warning = ( | |
7253e4e3 | 91 | "m/(?p{ 'a' })/" => "(?p{}) is deprecated - use (??{}) in regex; marked by {#} in m/(?p{#}{ 'a' })/", |
b45f050a | 92 | |
7253e4e3 | 93 | 'm/\b*/' => '\b* matches null string many times in regex; marked by {#} in m/\b*{#}/', |
b45f050a | 94 | |
7253e4e3 | 95 | 'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes in regex; marked by {#} in m/[:blank:]{#}/', |
b45f050a | 96 | |
7253e4e3 | 97 | "m'[\\y]'" => 'Unrecognized escape \y in character class passed through in regex; marked by {#} in m/[\y{#}]/', |
b45f050a | 98 | |
7253e4e3 RK |
99 | 'm/[a-\d]/' => 'False [] range "a-\d" in regex; marked by {#} in m/[a-\d{#}]/', |
100 | 'm/[\w-x]/' => 'False [] range "\w-" in regex; marked by {#} in m/[\w-{#}x]/', | |
101 | "m'\\y'" => 'Unrecognized escape \y passed through in regex; marked by {#} in m/\y{#}/', | |
b45f050a JF |
102 | ); |
103 | ||
104 | my $total = (@death + @warning)/2; | |
105 | ||
40809656 PP |
106 | # utf8 is a noop on EBCDIC platforms, it is not fatal |
107 | my $Is_EBCDIC = (ord('A') == 193); | |
108 | if ($Is_EBCDIC) { | |
109 | my @utf8_death = grep(/utf8/, @death); | |
7387eed8 | 110 | $total = $total - @utf8_death; |
40809656 PP |
111 | } |
112 | ||
b45f050a JF |
113 | print "1..$total\n"; |
114 | ||
115 | my $count = 0; | |
116 | ||
117 | while (@death) | |
118 | { | |
b45f050a JF |
119 | my $regex = shift @death; |
120 | my $result = shift @death; | |
40809656 PP |
121 | # skip the utf8 test on EBCDIC since they do not die |
122 | next if ($Is_EBCDIC && $regex =~ /utf8/); | |
123 | $count++; | |
b45f050a | 124 | |
b45f050a JF |
125 | $_ = "x"; |
126 | eval $regex; | |
127 | if (not $@) { | |
69f2e79d | 128 | print "# oops, $regex didn't die\nnot ok $count\n"; |
b45f050a JF |
129 | next; |
130 | } | |
131 | chomp $@; | |
b45f050a JF |
132 | $result =~ s/{\#}/$marker1/; |
133 | $result =~ s/{\#}/$marker2/; | |
b9bd2e23 | 134 | $result .= " at "; |
69f2e79d MG |
135 | if ($@ !~ /^\Q$result/) { |
136 | print "# For $regex, expected:\n# $result\n# Got:\n# $@\n#\nnot "; | |
b45f050a | 137 | } |
d8176a88 | 138 | print "ok $count - $regex\n"; |
b45f050a JF |
139 | } |
140 | ||
141 | ||
142 | our $warning; | |
143 | $SIG{__WARN__} = sub { $warning = shift }; | |
144 | ||
145 | while (@warning) | |
146 | { | |
147 | $count++; | |
148 | my $regex = shift @warning; | |
149 | my $result = shift @warning; | |
150 | ||
151 | undef $warning; | |
152 | $_ = "x"; | |
153 | eval $regex; | |
154 | ||
155 | if ($@) | |
156 | { | |
69f2e79d | 157 | print "# oops, $regex died with:\n#\t$@#\nnot ok $count\n"; |
b45f050a JF |
158 | next; |
159 | } | |
160 | ||
161 | if (not $warning) | |
162 | { | |
69f2e79d | 163 | print "# oops, $regex didn't generate a warning\nnot ok $count\n"; |
b45f050a JF |
164 | next; |
165 | } | |
b45f050a JF |
166 | $result =~ s/{\#}/$marker1/; |
167 | $result =~ s/{\#}/$marker2/; | |
b9bd2e23 | 168 | $result .= " at "; |
69f2e79d | 169 | if ($warning !~ /^\Q$result/) |
b45f050a | 170 | { |
69f2e79d MG |
171 | print <<"EOM"; |
172 | # For $regex, expected: | |
173 | # $result | |
174 | # Got: | |
175 | # $warning | |
176 | # | |
177 | not ok $count | |
178 | EOM | |
b45f050a JF |
179 | next; |
180 | } | |
d8176a88 | 181 | print "ok $count - $regex\n"; |
b45f050a JF |
182 | } |
183 | ||
184 | ||
185 |