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