This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Refactor a calculation
[perl5.git] / t / re / reg_mesg.t
CommitLineData
b45f050a
JF
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
cc7e6304 5 @INC = qw '../lib ../ext/re';
cb79f740 6 require './test.pl';
2b08d1e2 7 skip_all_without_unicode_tables();
cb79f740 8 eval 'require Config'; # assume defaults if this fails
b45f050a
JF
9}
10
cb79f740 11use strict;
c1d900c3 12use open qw(:utf8 :std);
b45f050a
JF
13
14##
15## If the markers used are changed (search for "MARKER1" in regcomp.c),
cb79f740 16## update only these two regexs, and leave the {#} in the @death/@warning
b45f050a
JF
17## arrays below. The {#} is a meta-marker -- it marks where the marker should
18## go.
cb79f740 19##
af01601c
KW
20## Returns empty string if that is what is expected. Otherwise, handles
21## either a scalar, turning it into a single element array; or a ref to an
22## array, adjusting each element. If called in array context, returns an
23## array, otherwise the join of all elements
24
cb79f740 25sub fixup_expect {
af01601c
KW
26 my $expect_ref = shift;
27 return if $expect_ref eq "";
28
29 my @expect;
30 if (ref $expect_ref) {
31 @expect = @$expect_ref;
32 }
33 else {
34 @expect = $expect_ref;
35 }
36
37 foreach my $element (@expect) {
6d24e9d4 38 $element =~ s/{\#}/in regex; marked by <-- HERE in/;
af01601c
KW
39 $element =~ s/{\#}/ <-- HERE /;
40 $element .= " at ";
41 }
42 return wantarray ? @expect : join "", @expect;
cb79f740 43}
b45f050a 44
c1d900c3 45## Because we don't "use utf8" in this file, we need to do some extra legwork
b0e1d434
KW
46## for the utf8 tests: Prepend 'use utf8' to the pattern, and mark the strings
47## to check against as UTF-8, but for this all to work properly, the character
48## 'ネ' (U+30CD) is required in each pattern somewhere as a marker.
4cabb89a
BF
49##
50## This also creates a second variant of the tests to check if the
b0e1d434
KW
51## latin1 error messages are working correctly. Because we don't 'use utf8',
52## we can't tell if something is UTF-8 or Latin1, so you need the suffix
53## '; no latin1' to not have the second variant.
4cabb89a
BF
54my $l1 = "\x{ef}";
55my $utf8 = "\x{30cd}";
56utf8::encode($utf8);
57
c1d900c3
BF
58sub mark_as_utf8 {
59 my @ret;
67cdf558
KW
60 for (my $i = 0; $i < @_; $i += 2) {
61 my $pat = $_[$i];
62 my $msg = $_[$i+1];
4cabb89a
BF
63 my $l1_pat = $pat =~ s/$utf8/$l1/gr;
64 my $l1_msg;
c1d900c3 65 $pat = "use utf8; $pat";
b0e1d434 66
c1d900c3 67 if (ref $msg) {
4cabb89a
BF
68 $l1_msg = [ map { s/$utf8/$l1/gr } @$msg ];
69 @$msg = map { my $c = $_; utf8::decode($c); $c } @$msg;
c1d900c3
BF
70 }
71 else {
4cabb89a 72 $l1_msg = $msg =~ s/$utf8/$l1/gr;
c1d900c3
BF
73 utf8::decode($msg);
74 }
75 push @ret, $pat => $msg;
b0e1d434 76
4cabb89a 77 push @ret, $l1_pat => $l1_msg unless $l1_pat =~ /#no latin1/;
c1d900c3
BF
78 }
79 return @ret;
80}
81
cb79f740
NC
82my $inf_m1 = ($Config::Config{reg_infty} || 32767) - 1;
83my $inf_p1 = $inf_m1 + 2;
b45f050a
JF
84
85##
86## Key-value pairs of code/error of code that should have fatal errors.
87##
88my @death =
89(
6d24e9d4 90 '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/',
b45f050a 91
58e23c8d 92 '/(?<= .*)/' => 'Variable length lookbehind not implemented in regex m/(?<= .*)/',
b45f050a 93
58e23c8d 94 '/(?<= x{1000})/' => 'Lookbehind longer than 255 not implemented in regex m/(?<= x{1000})/',
b45f050a 95
6d24e9d4 96 '/(?@)/' => 'Sequence (?@...) not implemented {#} m/(?@{#})/',
b45f050a 97
9da1dd8f 98 '/(?{ 1/' => 'Missing right curly or square bracket',
b45f050a 99
6d24e9d4 100 '/(?(1x))/' => 'Switch condition not recognized {#} m/(?(1x{#}))/',
311cc1ad 101 '/(?(1x(?#)))/'=> 'Switch condition not recognized {#} m/(?(1x{#}(?#)))/',
b45f050a 102
8fb0127d
YO
103 '/(?(1)/' => 'Switch (?(condition)... not terminated {#} m/(?(1){#}/',
104 '/(?(1)x/' => 'Switch (?(condition)... not terminated {#} m/(?(1)x{#}/',
105 '/(?(1)x|y/' => 'Switch (?(condition)... not terminated {#} m/(?(1)x|y{#}/',
6d24e9d4 106 '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches {#} m/(?(1)x|y|{#}z)/',
b45f050a 107
c1d900c3 108 '/(?(x)y|x)/' => 'Unknown switch condition (?(...)) {#} m/(?(x{#})y|x)/',
10380cb3
FC
109 '/(?(??{}))/' => 'Unknown switch condition (?(...)) {#} m/(?(?{#}?{}))/',
110 '/(?(?[]))/' => 'Unknown switch condition (?(...)) {#} m/(?(?{#}[]))/',
b45f050a 111
6d24e9d4 112 '/(?/' => 'Sequence (? incomplete {#} m/(?{#}/',
b45f050a 113
6d24e9d4
KW
114 '/(?;x/' => 'Sequence (?;...) not recognized {#} m/(?;{#}x/',
115 '/(?<;x/' => 'Group name must start with a non-digit word character {#} m/(?<;{#}x/',
116 '/(?\ix/' => 'Sequence (?\...) not recognized {#} m/(?\{#}ix/',
117 '/(?\mx/' => 'Sequence (?\...) not recognized {#} m/(?\{#}mx/',
118 '/(?\:x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}:x/',
119 '/(?\=x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}=x/',
120 '/(?\!x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}!x/',
121 '/(?\<=x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}<=x/',
122 '/(?\<!x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}<!x/',
123 '/(?\>x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}>x/',
124 '/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
125 '/(?^-i)foo/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i)foo/',
126 '/(?^d:foo)/' => 'Sequence (?^d...) not recognized {#} m/(?^d{#}:foo)/',
127 '/(?^d)foo/' => 'Sequence (?^d...) not recognized {#} m/(?^d{#})foo/',
128 '/(?^lu:foo)/' => 'Regexp modifiers "l" and "u" are mutually exclusive {#} m/(?^lu{#}:foo)/',
129 '/(?^lu)foo/' => 'Regexp modifiers "l" and "u" are mutually exclusive {#} m/(?^lu{#})foo/',
130'/(?da:foo)/' => 'Regexp modifiers "d" and "a" are mutually exclusive {#} m/(?da{#}:foo)/',
131'/(?lil:foo)/' => 'Regexp modifier "l" may not appear twice {#} m/(?lil{#}:foo)/',
132'/(?aaia:foo)/' => 'Regexp modifier "a" may appear a maximum of twice {#} m/(?aaia{#}:foo)/',
133'/(?i-l:foo)/' => 'Regexp modifier "l" may not appear after the "-" {#} m/(?i-l{#}:foo)/',
32d02813
KW
134'/a\b{cde/' => 'Use "\b\{" instead of "\b{" {#} m/a\{#}b{cde/',
135'/a\B{cde/' => 'Use "\B\{" instead of "\B{" {#} m/a\{#}B{cde/',
cc74c5bd 136
6d24e9d4 137 '/((x)/' => 'Unmatched ( {#} m/({#}(x)/',
b45f050a 138
6d24e9d4 139 "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 {#} m/x{{#}$inf_p1}/",
b45f050a 140
b45f050a 141
6d24e9d4 142 '/x**/' => 'Nested quantifiers {#} m/x**{#}/',
b45f050a 143
6d24e9d4 144 '/x[/' => 'Unmatched [ {#} m/x[{#}/',
b45f050a 145
6d24e9d4 146 '/*/', => 'Quantifier follows nothing {#} m/*{#}/',
b45f050a 147
6d24e9d4 148 '/\p{x/' => 'Missing right brace on \p{} {#} m/\p{{#}x/',
b45f050a 149
6d24e9d4 150 '/[\p{x]/' => 'Missing right brace on \p{} {#} m/[\p{{#}x]/',
b45f050a 151
6d24e9d4 152 '/(x)\2/' => 'Reference to nonexistent group {#} m/(x)\2{#}/',
b45f050a 153
779fedd7 154 '/\g/' => 'Unterminated \g... pattern {#} m/\g{#}/',
76cccc4d
KW
155 '/\g{1/' => 'Unterminated \g{...} pattern {#} m/\g{1{#}/',
156
40809656 157 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/',
b45f050a 158
6d24e9d4
KW
159 '/\x{1/' => 'Missing right brace on \x{} {#} m/\x{1{#}/',
160 '/\x{X/' => 'Missing right brace on \x{} {#} m/\x{{#}X/',
161
162 '/[\x{X]/' => 'Missing right brace on \x{} {#} m/[\x{{#}X]/',
163 '/[\x{A]/' => 'Missing right brace on \x{} {#} m/[\x{A{#}]/',
164
165 '/\o{1/' => 'Missing right brace on \o{ {#} m/\o{1{#}/',
166 '/\o{X/' => 'Missing right brace on \o{ {#} m/\o{{#}X/',
167
168 '/[\o{X]/' => 'Missing right brace on \o{ {#} m/[\o{{#}X]/',
169 '/[\o{7]/' => 'Missing right brace on \o{ {#} m/[\o{7{#}]/',
170
171 '/[[:barf:]]/' => 'POSIX class [:barf:] unknown {#} m/[[:barf:]{#}]/',
172
173 '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=barf=]{#}]/',
174
175 '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions {#} m/[[.barf.]{#}]/',
176
177 '/[z-a]/' => 'Invalid [] range "z-a" {#} m/[z-a{#}]/',
178
179 '/\p/' => 'Empty \p{} {#} m/\p{#}/',
180
181 '/\P{}/' => 'Empty \P{} {#} m/\P{{#}}/',
182 '/(?[[[:word]]])/' => "Unmatched ':' in POSIX class {#} m/(?[[[:word{#}]]])/",
183 '/(?[[:word]])/' => "Unmatched ':' in POSIX class {#} m/(?[[:word{#}]])/",
184 '/(?[[[:digit: ])/' => "Unmatched '[' in POSIX class {#} m/(?[[[:digit:{#} ])/",
185 '/(?[[:digit: ])/' => "Unmatched '[' in POSIX class {#} m/(?[[:digit:{#} ])/",
186 '/(?[[[::]]])/' => "POSIX class [::] unknown {#} m/(?[[[::]{#}]])/",
187 '/(?[[[:w:]]])/' => "POSIX class [:w:] unknown {#} m/(?[[[:w:]{#}]])/",
188 '/(?[[:w:]])/' => "POSIX class [:w:] unknown {#} m/(?[[:w:]{#}])/",
189 '/(?[a])/' => 'Unexpected character {#} m/(?[a{#}])/',
190 '/(?[\t])/l' => '(?[...]) not valid in locale {#} m/(?[{#}\t])/',
191 '/(?[ + \t ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/(?[ +{#} \t ])/',
192 '/(?[ \cK - ( + \t ) ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/(?[ \cK - ( +{#} \t ) ])/',
193 '/(?[ \cK ( \t ) ])/' => 'Unexpected \'(\' with no preceding operator {#} m/(?[ \cK ({#} \t ) ])/',
194 '/(?[ \cK \t ])/' => 'Operand with no preceding operator {#} m/(?[ \cK \t{#} ])/',
195 '/(?[ \0004 ])/' => 'Need exactly 3 octal digits {#} m/(?[ \0004 {#}])/',
196 '/(?[ \05 ])/' => 'Need exactly 3 octal digits {#} m/(?[ \05 {#}])/',
197 '/(?[ \o{1038} ])/' => 'Non-octal character {#} m/(?[ \o{1038{#}} ])/',
198 '/(?[ \o{} ])/' => 'Number with no digits {#} m/(?[ \o{}{#} ])/',
199 '/(?[ \x{defg} ])/' => 'Non-hex character {#} m/(?[ \x{defg{#}} ])/',
200 '/(?[ \xabcdef ])/' => 'Use \\x{...} for more than two hex characters {#} m/(?[ \xabc{#}def ])/',
201 '/(?[ \x{} ])/' => 'Number with no digits {#} m/(?[ \x{}{#} ])/',
202 '/(?[ \cK + ) ])/' => 'Unexpected \')\' {#} m/(?[ \cK + ){#} ])/',
203 '/(?[ \cK + ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ \cK + {#}])/',
204 '/(?[ \p{foo} ])/' => 'Property \'foo\' is unknown {#} m/(?[ \p{foo}{#} ])/',
205 '/(?[ \p{ foo = bar } ])/' => 'Property \'foo = bar\' is unknown {#} m/(?[ \p{ foo = bar }{#} ])/',
206 '/(?[ \8 ])/' => 'Unrecognized escape \8 in character class {#} m/(?[ \8{#} ])/',
3f4fde43
KW
207 '/(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ]/',
208 '/(?[ [ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ \t ]/',
209 '/(?[ \t ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ] ]/',
210 '/(?[ [ ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ ] ]/',
211 '/(?[ \t + \e # This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # This was supposed to be a comment ])/',
6d24e9d4
KW
212 '/(?[ ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ {#}])/',
213 'm/(?[[a-\d]])/' => 'False [] range "a-\d" {#} m/(?[[a-\d{#}]])/',
214 'm/(?[[\w-x]])/' => 'False [] range "\w-" {#} m/(?[[\w-{#}x]])/',
215 'm/(?[[a-\pM]])/' => 'False [] range "a-\pM" {#} m/(?[[a-\pM{#}]])/',
216 'm/(?[[\pM-x]])/' => 'False [] range "\pM-" {#} m/(?[[\pM-{#}x]])/',
8f0cd35a 217 'm/(?[[^\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]])/' => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/(?[[^\N{U+100.300{#}}]])/',
b5864679
KW
218 'm/(?[ \p{Digit} & (?(?[ \p{Thai} | \p{Lao} ]))])/' => 'Sequence (?(...) not recognized {#} m/(?[ \p{Digit} & (?({#}?[ \p{Thai} | \p{Lao} ]))])/',
219 'm/(?[ \p{Digit} & (?:(?[ \p{Thai} | \p{Lao} ]))])/' => 'Expecting \'(?flags:(?[...\' {#} m/(?[ \p{Digit} & (?{#}:(?[ \p{Thai} | \p{Lao} ]))])/',
6d24e9d4
KW
220 'm/\o{/' => 'Missing right brace on \o{ {#} m/\o{{#}/',
221 'm/\o/' => 'Missing braces on \o{} {#} m/\o{#}/',
222 'm/\o{}/' => 'Number with no digits {#} m/\o{}{#}/',
223 'm/[\o{]/' => 'Missing right brace on \o{ {#} m/[\o{{#}]/',
224 'm/[\o]/' => 'Missing braces on \o{} {#} m/[\o{#}]/',
225 'm/[\o{}]/' => 'Number with no digits {#} m/[\o{}{#}]/',
226 'm/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
f1e1b256
YO
227 'm/\87/' => 'Reference to nonexistent group {#} m/\87{#}/',
228 'm/a\87/' => 'Reference to nonexistent group {#} m/a\87{#}/',
229 'm/a\97/' => 'Reference to nonexistent group {#} m/a\97{#}/',
07ea66ee
FC
230 'm/(*DOOF)/' => 'Unknown verb pattern \'DOOF\' {#} m/(*DOOF){#}/',
231 'm/(?&a/' => 'Sequence (?&... not terminated {#} m/(?&a{#}/',
75839571
FC
232 'm/(?P=/' => 'Sequence ?P=... not terminated {#} m/(?P={#}/',
233 "m/(?'/" => "Sequence (?'... not terminated {#} m/(?'{#}/",
234 "m/(?</" => "Sequence (?<... not terminated {#} m/(?<{#}/",
235 'm/(?&/' => 'Sequence (?&... not terminated {#} m/(?&{#}/',
236 'm/(?(</' => 'Sequence (?(<... not terminated {#} m/(?(<{#}/',
237 "m/(?('/" => "Sequence (?('... not terminated {#} m/(?('{#}/",
238 'm/\g{/' => 'Sequence \g{... not terminated {#} m/\g{{#}/',
239 'm/\k</' => 'Sequence \k<... not terminated {#} m/\k<{#}/',
9b8f4e92 240 'm/\cß/' => "Character following \"\\c\" must be printable ASCII",
cd209d9d
KW
241 '/((?# This is a comment in the middle of a token)?:foo)/' => 'In \'(?...)\', the \'(\' and \'?\' must be adjacent {#} m/((?# This is a comment in the middle of a token)?{#}:foo)/',
242 '/((?# This is a comment in the middle of a token)*FAIL)/' => 'In \'(*VERB...)\', the \'(\' and \'*\' must be adjacent {#} m/((?# This is a comment in the middle of a token)*{#}FAIL)/',
b45f050a 243);
c1d900c3 244
67cdf558
KW
245# These are messages that are warnings when not strict; death under 'use re
246# "strict". See comment before @warnings as to why some have a \x{100} in
247# them. This array has 3 elements per construct. [0] is the regex to use;
248# [1] is the message under no strict, and [2] is under strict.
249my @death_only_under_strict = (
250 'm/\xABC/' => "",
251 => 'Use \x{...} for more than two hex characters {#} m/\xABC{#}/',
252 'm/[\xABC]/' => "",
253 => 'Use \x{...} for more than two hex characters {#} m/[\xABC{#}]/',
254
255 # XXX This is a confusing error message. The G isn't ignored; it just
256 # terminates the \x. Also some messages below are missing the <-- HERE,
257 # aren't all category 'regexp'. (Hence we have to turn off 'digit'
258 # messages as well below)
259 'm/\xAG/' => 'Illegal hexadecimal digit \'G\' ignored',
260 => 'Non-hex character {#} m/\xAG{#}/',
261 'm/[\xAG]/' => 'Illegal hexadecimal digit \'G\' ignored',
262 => 'Non-hex character {#} m/[\xAG{#}]/',
263 'm/\o{789}/' => 'Non-octal character \'8\'. Resolved as "\o{7}"',
264 => 'Non-octal character {#} m/\o{78{#}9}/',
265 'm/[\o{789}]/' => 'Non-octal character \'8\'. Resolved as "\o{7}"',
266 => 'Non-octal character {#} m/[\o{78{#}9}]/',
267 'm/\x{}/' => "",
268 => 'Number with no digits {#} m/\x{}{#}/',
269 'm/[\x{}]/' => "",
270 => 'Number with no digits {#} m/[\x{}{#}]/',
271 'm/\x{ABCDEFG}/' => 'Illegal hexadecimal digit \'G\' ignored',
272 => 'Non-hex character {#} m/\x{ABCDEFG{#}}/',
273 'm/[\x{ABCDEFG}]/' => 'Illegal hexadecimal digit \'G\' ignored',
274 => 'Non-hex character {#} m/[\x{ABCDEFG{#}}]/',
275 'm/[[:ascii]]/' => "",
276 => 'Unmatched \':\' in POSIX class {#} m/[[:ascii{#}]]/',
277 'm/[\N{}]/' => 'Ignoring zero length \\N{} in character class {#} m/[\\N{}{#}]/',
278 => 'Zero length \\N{} {#} m/[\\N{}]{#}/',
279 "m'[\\y]\\x{100}'" => 'Unrecognized escape \y in character class passed through {#} m/[\y{#}]\x{100}/',
280 => 'Unrecognized escape \y in character class {#} m/[\y{#}]\x{100}/',
281 'm/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/',
282 => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/',
283 'm/[\w-x]\x{100}/' => 'False [] range "\w-" {#} m/[\w-{#}x]\x{100}/',
284 => 'False [] range "\w-" {#} m/[\w-{#}x]\x{100}/',
285 'm/[a-\pM]\x{100}/' => 'False [] range "a-\pM" {#} m/[a-\pM{#}]\x{100}/',
286 => 'False [] range "a-\pM" {#} m/[a-\pM{#}]\x{100}/',
287 'm/[\pM-x]\x{100}/' => 'False [] range "\pM-" {#} m/[\pM-{#}x]\x{100}/',
288 => 'False [] range "\pM-" {#} m/[\pM-{#}x]\x{100}/',
289 'm/[^\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[^\N{U+100.300}{#}]/',
290 => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[^\N{U+100.300{#}}]/',
291 'm/[\x03-\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\x03-\N{U+100.300}{#}]/',
292 => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[\x03-\N{U+100.300{#}}]/',
293 'm/[\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}-\x{10FFFF}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\N{U+100.300}{#}-\x{10FFFF}]/',
294 => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[\N{U+100.300{#}}-\x{10FFFF}]/',
295 '/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/',
296 => 'Need exactly 3 octal digits {#} m/[\08{#}]/',
297 '/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/',
298 => 'Need exactly 3 octal digits {#} m/[\018{#}]/',
299 '/[\_\0]/' => "",
300 => 'Need exactly 3 octal digits {#} m/[\_\0]{#}/',
301 '/[\07]/' => "",
302 => 'Need exactly 3 octal digits {#} m/[\07]{#}/',
303 '/[\0005]/' => "",
304 => 'Need exactly 3 octal digits {#} m/[\0005]{#}/',
305 '/[\8\9]\x{100}/' => ['Unrecognized escape \8 in character class passed through {#} m/[\8{#}\9]\x{100}/',
306 'Unrecognized escape \9 in character class passed through {#} m/[\8\9{#}]\x{100}/',
307 ],
308 => 'Unrecognized escape \8 in character class {#} m/[\8{#}\9]\x{100}/',
309 '/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/',
310 => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/',
311 '/[\d-b]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}b]\x{100}/',
312 => 'False [] range "\d-" {#} m/[\d-{#}b]\x{100}/',
313 '/[\s-\d]\x{100}/' => 'False [] range "\s-" {#} m/[\s-{#}\d]\x{100}/',
314 => 'False [] range "\s-" {#} m/[\s-{#}\d]\x{100}/',
315 '/[\d-\s]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}\s]\x{100}/',
316 => 'False [] range "\d-" {#} m/[\d-{#}\s]\x{100}/',
317 '/[a-[:digit:]]\x{100}/' => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]\x{100}/',
318 => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]\x{100}/',
319 '/[[:digit:]-b]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]\x{100}/',
320 => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]\x{100}/',
321 '/[[:alpha:]-[:digit:]]\x{100}/' => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]\x{100}/',
322 => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]\x{100}/',
323 '/[[:digit:]-[:alpha:]]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/',
324 => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/',
325 '/[a\zb]\x{100}/' => 'Unrecognized escape \z in character class passed through {#} m/[a\z{#}b]\x{100}/',
326 => 'Unrecognized escape \z in character class {#} m/[a\z{#}b]\x{100}/',
327);
328
b0e1d434 329# These need the character 'ネ' as a marker for mark_as_utf8()
c1d900c3
BF
330my @death_utf8 = mark_as_utf8(
331 '/ネ[[=ネ=]]ネ/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/ネ[[=ネ=]{#}]ネ/',
332 '/ネ(?<= .*)/' => 'Variable length lookbehind not implemented in regex m/ネ(?<= .*)/',
333
334 '/(?<= ネ{1000})/' => 'Lookbehind longer than 255 not implemented in regex m/(?<= ネ{1000})/',
335
336 '/ネ(?ネ)ネ/' => 'Sequence (?ネ...) not recognized {#} m/ネ(?ネ{#})ネ/',
337
476afc4b 338 '/ネ(?(1ネ))ネ/' => 'Switch condition not recognized {#} m/ネ(?(1ネ{#}))ネ/',
c1d900c3
BF
339
340 '/(?(1)ネ|y|ヌ)/' => 'Switch (?(condition)... contains too many branches {#} m/(?(1)ネ|y|{#}ヌ)/',
341
342 '/(?(ネ)y|ネ)/' => 'Unknown switch condition (?(...)) {#} m/(?(ネ{#})y|ネ)/',
343
344 '/ネ(?/' => 'Sequence (? incomplete {#} m/ネ(?{#}/',
345
346 '/ネ(?;ネ/' => 'Sequence (?;...) not recognized {#} m/ネ(?;{#}ネ/',
347 '/ネ(?<;ネ/' => 'Group name must start with a non-digit word character {#} m/ネ(?<;{#}ネ/',
348 '/ネ(?\ixネ/' => 'Sequence (?\...) not recognized {#} m/ネ(?\{#}ixネ/',
349 '/ネ(?^lu:ネ)/' => 'Regexp modifiers "l" and "u" are mutually exclusive {#} m/ネ(?^lu{#}:ネ)/',
350'/ネ(?lil:ネ)/' => 'Regexp modifier "l" may not appear twice {#} m/ネ(?lil{#}:ネ)/',
351'/ネ(?aaia:ネ)/' => 'Regexp modifier "a" may appear a maximum of twice {#} m/ネ(?aaia{#}:ネ)/',
352'/ネ(?i-l:ネ)/' => 'Regexp modifier "l" may not appear after the "-" {#} m/ネ(?i-l{#}:ネ)/',
353
354 '/ネ((ネ)/' => 'Unmatched ( {#} m/ネ({#}(ネ)/',
355
356 "/ネ{$inf_p1}ネ/" => "Quantifier in {,} bigger than $inf_m1 {#} m/ネ{{#}$inf_p1}ネ/",
357
358
359 '/ネ**ネ/' => 'Nested quantifiers {#} m/ネ**{#}ネ/',
360
361 '/ネ[ネ/' => 'Unmatched [ {#} m/ネ[{#}ネ/',
362
363 '/*ネ/', => 'Quantifier follows nothing {#} m/*{#}ネ/',
364
365 '/ネ\p{ネ/' => 'Missing right brace on \p{} {#} m/ネ\p{{#}ネ/',
366
367 '/(ネ)\2ネ/' => 'Reference to nonexistent group {#} m/(ネ)\2{#}ネ/',
368
4cabb89a 369 '/\g{ネ/; #no latin1' => 'Sequence \g{... not terminated {#} m/\g{ネ{#}/',
c1d900c3
BF
370
371 'my $m = "ネ\\\"; $m =~ $m', => 'Trailing \ in regex m/ネ\/',
372
373 '/\x{ネ/' => 'Missing right brace on \x{} {#} m/\x{{#}ネ/',
374 '/ネ[\x{ネ]ネ/' => 'Missing right brace on \x{} {#} m/ネ[\x{{#}ネ]ネ/',
375 '/ネ[\x{ネ]/' => 'Missing right brace on \x{} {#} m/ネ[\x{{#}ネ]/',
376
377 '/ネ\o{ネ/' => 'Missing right brace on \o{ {#} m/ネ\o{{#}ネ/',
378 '/ネ[[:ネ:]]ネ/' => 'POSIX class [:ネ:] unknown {#} m/ネ[[:ネ:]{#}]ネ/',
379
380 '/ネ[[=ネ=]]ネ/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/ネ[[=ネ=]{#}]ネ/',
381
382 '/ネ[[.ネ.]]ネ/' => 'POSIX syntax [. .] is reserved for future extensions {#} m/ネ[[.ネ.]{#}]ネ/',
383
384 '/[ネ-a]ネ/' => 'Invalid [] range "ネ-a" {#} m/[ネ-a{#}]ネ/',
385
386 '/ネ\p{}ネ/' => 'Empty \p{} {#} m/ネ\p{{#}}ネ/',
387
388 '/ネ(?[[[:ネ]]])ネ/' => "Unmatched ':' in POSIX class {#} m/ネ(?[[[:ネ{#}]]])ネ/",
389 '/ネ(?[[[:ネ: ])ネ/' => "Unmatched '[' in POSIX class {#} m/ネ(?[[[:ネ:{#} ])ネ/",
390 '/ネ(?[[[::]]])ネ/' => "POSIX class [::] unknown {#} m/ネ(?[[[::]{#}]])ネ/",
391 '/ネ(?[[[:ネ:]]])ネ/' => "POSIX class [:ネ:] unknown {#} m/ネ(?[[[:ネ:]{#}]])ネ/",
392 '/ネ(?[[:ネ:]])ネ/' => "POSIX class [:ネ:] unknown {#} m/ネ(?[[:ネ:]{#}])ネ/",
393 '/ネ(?[ネ])ネ/' => 'Unexpected character {#} m/ネ(?[ネ{#}])ネ/',
394 '/ネ(?[ネ])/l' => '(?[...]) not valid in locale {#} m/ネ(?[{#}ネ])/',
395 '/ネ(?[ + [ネ] ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/ネ(?[ +{#} [ネ] ])/',
396 '/ネ(?[ \cK - ( + [ネ] ) ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/ネ(?[ \cK - ( +{#} [ネ] ) ])/',
397 '/ネ(?[ \cK ( [ネ] ) ])/' => 'Unexpected \'(\' with no preceding operator {#} m/ネ(?[ \cK ({#} [ネ] ) ])/',
398 '/ネ(?[ \cK [ネ] ])ネ/' => 'Operand with no preceding operator {#} m/ネ(?[ \cK [ネ{#}] ])ネ/',
399 '/ネ(?[ \0004 ])ネ/' => 'Need exactly 3 octal digits {#} m/ネ(?[ \0004 {#}])ネ/',
400 '/(?[ \o{ネ} ])ネ/' => 'Non-octal character {#} m/(?[ \o{ネ{#}} ])ネ/',
401 '/ネ(?[ \o{} ])ネ/' => 'Number with no digits {#} m/ネ(?[ \o{}{#} ])ネ/',
402 '/(?[ \x{ネ} ])ネ/' => 'Non-hex character {#} m/(?[ \x{ネ{#}} ])ネ/',
403 '/(?[ \p{ネ} ])/' => 'Property \'ネ\' is unknown {#} m/(?[ \p{ネ}{#} ])/',
404 '/(?[ \p{ ネ = bar } ])/' => 'Property \'ネ = bar\' is unknown {#} m/(?[ \p{ ネ = bar }{#} ])/',
405 '/ネ(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/ネ(?[ \t ]/',
406 '/(?[ \t + \e # ネ This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # ネ This was supposed to be a comment ])/',
9b8f4e92
KW
407 'm/(*ネ)ネ/' => q<Unknown verb pattern 'ネ' {#} m/(*ネ){#}ネ/>,
408 '/\cネ/' => "Character following \"\\c\" must be printable ASCII",
c1d900c3
BF
409);
410push @death, @death_utf8;
411
67cdf558
KW
412my @death_utf8_only_under_strict = (
413 "m'ネ[\\y]ネ'" => 'Unrecognized escape \y in character class passed through {#} m/ネ[\y{#}]ネ/',
414 => 'Unrecognized escape \y in character class {#} m/ネ[\y{#}]ネ/',
415 'm/ネ[ネ-\d]ネ/' => 'False [] range "ネ-\d" {#} m/ネ[ネ-\d{#}]ネ/',
416 => 'False [] range "ネ-\d" {#} m/ネ[ネ-\d{#}]ネ/',
417 'm/ネ[\w-ネ]ネ/' => 'False [] range "\w-" {#} m/ネ[\w-{#}ネ]ネ/',
418 => 'False [] range "\w-" {#} m/ネ[\w-{#}ネ]ネ/',
419 'm/ネ[ネ-\pM]ネ/' => 'False [] range "ネ-\pM" {#} m/ネ[ネ-\pM{#}]ネ/',
420 => 'False [] range "ネ-\pM" {#} m/ネ[ネ-\pM{#}]ネ/',
421 '/ネ[ネ-[:digit:]]ネ/' => 'False [] range "ネ-[:digit:]" {#} m/ネ[ネ-[:digit:]{#}]ネ/',
422 => 'False [] range "ネ-[:digit:]" {#} m/ネ[ネ-[:digit:]{#}]ネ/',
423 '/ネ[\d-\s]ネ/' => 'False [] range "\d-" {#} m/ネ[\d-{#}\s]ネ/',
424 => 'False [] range "\d-" {#} m/ネ[\d-{#}\s]ネ/',
425 '/ネ[a\zb]ネ/' => 'Unrecognized escape \z in character class passed through {#} m/ネ[a\z{#}b]ネ/',
426 => 'Unrecognized escape \z in character class {#} m/ネ[a\z{#}b]ネ/',
427);
902994e4 428# Tests involving a user-defined charnames translator are in pat_advanced.t
b45f050a 429
af01601c
KW
430# In the following arrays of warnings, the value can be an array of things to
431# expect. If the empty string, it means no warning should be raised.
432
6d24e9d4 433
499333dc
KW
434# Key-value pairs of code/error of code that should have non-fatal regexp
435# warnings. Most currently have \x{100} appended to them to force them to be
436# upgraded to UTF-8, and the first pass restarted. Previously this would
437# cause some warnings to be output twice. This tests that that behavior has
438# been fixed.
6d24e9d4 439
499333dc
KW
440my @warning = (
441 'm/\b*\x{100}/' => '\b* matches null string many times {#} m/\b*{#}\x{100}/',
442 'm/[:blank:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:blank:]{#}\x{100}/',
499333dc 443 "m'\\y\\x{100}'" => 'Unrecognized escape \y passed through {#} m/\y{#}\x{100}/',
6d24e9d4
KW
444 '/x{3,1}/' => 'Quantifier {n,m} with n > m can\'t match {#} m/x{3,1}{#}/',
445 '/\08/' => '\'\08\' resolved to \'\o{0}8\' {#} m/\08{#}/',
446 '/\018/' => '\'\018\' resolved to \'\o{1}8\' {#} m/\018{#}/',
6d24e9d4
KW
447 '/(?=a)*/' => '(?=a)* matches null string many times {#} m/(?=a)*{#}/',
448 'my $x = \'\m\'; qr/a$x/' => 'Unrecognized escape \m passed through {#} m/a\m{#}/',
449 '/\q/' => 'Unrecognized escape \q passed through {#} m/\q{#}/',
499333dc 450
e1729dc6
FC
451 # These two tests do not include the marker, because regcomp.c no
452 # longer knows where it goes by the time this warning is emitted.
453 # See [perl #122680] regcomp warning gives wrong position of
499333dc 454 # problem.
e1729dc6
FC
455 '/(?=a){1,3}\x{100}/' => 'Quantifier unexpected on zero-length expression in regex m/(?=a){1,3}\x{100}/',
456 '/(a|b)(?=a){3}\x{100}/' => 'Quantifier unexpected on zero-length expression in regex m/(a|b)(?=a){3}\x{100}/',
499333dc 457
63fbd1cb 458 '/\_/' => "",
63fbd1cb 459 '/[\006]/' => "",
499333dc
KW
460 '/[:alpha:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:alpha:]{#}\x{100}/',
461 '/[:zog:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:zog:]{#}\x{100}/',
462 '/[.zog.]\x{100}/' => 'POSIX syntax [. .] belongs inside character classes {#} m/[.zog.]{#}\x{100}/',
63fbd1cb 463 '/[a-b]/' => "",
499333dc
KW
464 '/(?c)\x{100}/' => 'Useless (?c) - use /gc modifier {#} m/(?c{#})\x{100}/',
465 '/(?-c)\x{100}/' => 'Useless (?-c) - don\'t use /gc modifier {#} m/(?-c{#})\x{100}/',
466 '/(?g)\x{100}/' => 'Useless (?g) - use /g modifier {#} m/(?g{#})\x{100}/',
467 '/(?-g)\x{100}/' => 'Useless (?-g) - don\'t use /g modifier {#} m/(?-g{#})\x{100}/',
468 '/(?o)\x{100}/' => 'Useless (?o) - use /o modifier {#} m/(?o{#})\x{100}/',
469 '/(?-o)\x{100}/' => 'Useless (?-o) - don\'t use /o modifier {#} m/(?-o{#})\x{100}/',
470 '/(?g-o)\x{100}/' => [ 'Useless (?g) - use /g modifier {#} m/(?g{#}-o)\x{100}/',
471 'Useless (?-o) - don\'t use /o modifier {#} m/(?g-o{#})\x{100}/',
63fbd1cb 472 ],
499333dc
KW
473 '/(?g-c)\x{100}/' => [ 'Useless (?g) - use /g modifier {#} m/(?g{#}-c)\x{100}/',
474 'Useless (?-c) - don\'t use /gc modifier {#} m/(?g-c{#})\x{100}/',
63fbd1cb
KW
475 ],
476 # (?c) means (?g) error won't be thrown
499333dc
KW
477 '/(?o-cg)\x{100}/' => [ 'Useless (?o) - use /o modifier {#} m/(?o{#}-cg)\x{100}/',
478 'Useless (?-c) - don\'t use /gc modifier {#} m/(?o-c{#}g)\x{100}/',
63fbd1cb 479 ],
499333dc
KW
480 '/(?ogc)\x{100}/' => [ 'Useless (?o) - use /o modifier {#} m/(?o{#}gc)\x{100}/',
481 'Useless (?g) - use /g modifier {#} m/(?og{#}c)\x{100}/',
482 'Useless (?c) - use /gc modifier {#} m/(?ogc{#})\x{100}/',
63fbd1cb 483 ],
499333dc
KW
484 '/a{1,1}?\x{100}/' => 'Useless use of greediness modifier \'?\' {#} m/a{1,1}?{#}\x{100}/',
485 '/b{3} +\x{100}/x' => 'Useless use of greediness modifier \'+\' {#} m/b{3} +{#}\x{100}/',
486); # See comments before this for why '\x{100}' is generally needed
6fe2934b 487
b0e1d434 488# These need the character 'ネ' as a marker for mark_as_utf8()
c1d900c3
BF
489my @warnings_utf8 = mark_as_utf8(
490 'm/ネ\b*ネ/' => '\b* matches null string many times {#} m/ネ\b*{#}ネ/',
491 '/(?=ネ)*/' => '(?=ネ)* matches null string many times {#} m/(?=ネ)*{#}/',
492 'm/ネ[:foo:]ネ/' => 'POSIX syntax [: :] belongs inside character classes {#} m/ネ[:foo:]{#}ネ/',
b0e1d434 493 '/ネ(?c)ネ/' => 'Useless (?c) - use /gc modifier {#} m/ネ(?c{#})ネ/',
c1d900c3
BF
494 '/utf8 ネ (?ogc) ネ/' => [
495 'Useless (?o) - use /o modifier {#} m/utf8 ネ (?o{#}gc) ネ/',
496 'Useless (?g) - use /g modifier {#} m/utf8 ネ (?og{#}c) ネ/',
497 'Useless (?c) - use /gc modifier {#} m/utf8 ネ (?ogc{#}) ネ/',
498 ],
499
500);
501
502push @warning, @warnings_utf8;
503
6fe2934b 504my @experimental_regex_sets = (
6d24e9d4 505 '/(?[ \t ])/' => 'The regex_sets feature is experimental {#} m/(?[{#} \t ])/',
c1d900c3
BF
506 'use utf8; /utf8 ネ (?[ [\tネ] ])/' => do { use utf8; 'The regex_sets feature is experimental {#} m/utf8 ネ (?[{#} [\tネ] ])/' },
507 '/noutf8 ネ (?[ [\tネ] ])/' => 'The regex_sets feature is experimental {#} m/noutf8 ネ (?[{#} [\tネ] ])/',
b45f050a
JF
508);
509
63fbd1cb 510my @deprecated = (
412f55bb
KW
511 '/\w{/' => 'Unescaped left brace in regex is deprecated, passed through {#} m/\w{{#}/',
512 '/\q{/' => [
513 'Unrecognized escape \q{ passed through {#} m/\q{{#}/',
514 'Unescaped left brace in regex is deprecated, passed through {#} m/\q{{#}/'
515 ],
516 '/:{4,a}/' => 'Unescaped left brace in regex is deprecated, passed through {#} m/:{{#}4,a}/',
cc4d09e1
KW
517 '/abc/xix' => 'Having more than one /x regexp modifier is deprecated',
518 '/(?xmsixp:abc)/' => 'Having more than one /x regexp modifier is deprecated',
519 '/(?xmsixp)abc/' => 'Having more than one /x regexp modifier is deprecated',
520 '/(?xxxx:abc)/' => 'Having more than one /x regexp modifier is deprecated',
63fbd1cb
KW
521);
522
67cdf558
KW
523for my $strict ("", "use re 'strict';") {
524
525 # First time just use @death; but under strict we add the things that fail
526 # there. Doing it this way makes sure that 'strict' doesnt change the
527 # things that are already fatal when not under strict.
528 if ($strict) {
529 for (my $i = 0; $i < @death_only_under_strict; $i += 3) {
530 push @death, $death_only_under_strict[$i], # The regex
531 $death_only_under_strict[$i+2]; # The fatal msg
532 }
533 for (my $i = 0; $i < @death_utf8_only_under_strict; $i += 3) {
534
535 # Same with the utf8 versions
536 push @death, mark_as_utf8($death_utf8_only_under_strict[$i],
537 $death_utf8_only_under_strict[$i+2]);
538 }
539 }
d6609144
KW
540 for (my $i = 0; $i < @death; $i += 2) {
541 my $regex = $death[$i];
542 my $expect = fixup_expect($death[$i+1]);
543 no warnings 'experimental::regex_sets';
544 no warnings 'experimental::re_strict';
d6609144
KW
545
546 warning_is(sub {
547 my $eval_string = "$strict $regex";
548 $_ = "x";
549 eval $eval_string;
550 like($@, qr/\Q$expect/, $eval_string);
551 }, undef, "... and died without any other warnings");
552 }
67cdf558 553}
b45f050a 554
67cdf558
KW
555for my $strict ("no warnings 'experimental::re_strict'; use re 'strict';", "") {
556
557 # First time through we use strict to make sure that that doesn't change
558 # any of the warnings into fatal, and outputs them correctly. The second
559 # time we don't use strict, and add the messages that are warnings when
560 # not under strict to the list of warnings. This checks that non-strict
561 # works.
562 if (! $strict) {
563 for (my $i = 0; $i < @death_only_under_strict; $i += 3) {
564 push @warning, $death_only_under_strict[$i], # The regex
565 $death_only_under_strict[$i+1]; # The warning
566 }
567 for (my $i = 0; $i < @death_utf8_only_under_strict; $i += 3) {
d6609144
KW
568 push @warning, mark_as_utf8($death_utf8_only_under_strict[$i],
569 $death_utf8_only_under_strict[$i+1]);
67cdf558
KW
570 }
571 }
d6609144
KW
572
573 foreach my $ref (\@warning, \@experimental_regex_sets, \@deprecated) {
574 my $warning_type;
575 my $default_on;
576 if ($ref == \@warning) {
577 $warning_type = 'regexp, digit';
578 $default_on = $strict;
af01601c 579 }
d6609144
KW
580 elsif ($ref == \@deprecated) {
581 $warning_type = 'regexp, deprecated';
582 $default_on = 1;
583 }
584 else {
585 $warning_type = 'experimental::regex_sets';
586 $default_on = 1;
587 }
588 for (my $i = 0; $i < @$ref; $i += 2) {
589 my $regex = $ref->[$i];
590 my @expect = fixup_expect($ref->[$i+1]);
591 {
592 $_ = "x";
593 eval "$strict no warnings; $regex";
af01601c 594 }
d6609144
KW
595 if (is($@, "", "$strict $regex did not die")) {
596 my @got = capture_warnings(sub {
597 $_ = "x";
598 eval "$strict $regex" });
599 my $count = @expect;
600 if (! is(scalar @got, scalar @expect,
601 "... and gave expected number ($count) of warnings"))
602 {
603 if (@got < @expect) {
604 $count = @got;
605 note "Expected warnings not gotten:\n\t" . join "\n\t",
606 @expect[$count .. $#expect];
607 }
608 else {
609 note "Unexpected warnings gotten:\n\t" . join("\n\t",
610 @got[$count .. $#got]);
611 }
b0b90d25 612 }
d6609144
KW
613 foreach my $i (0 .. $count - 1) {
614 if (! like($got[$i], qr/\Q$expect[$i]/,
615 "... and gave expected warning"))
616 {
617 chomp($got[$i]);
618 chomp($expect[$i]);
619 diag("GOT\n'$got[$i]'\nEXPECT\n'$expect[$i]'");
67cdf558
KW
620 }
621 else {
d6609144
KW
622 ok (0 == capture_warnings(sub {
623 $_ = "x";
624 eval "$strict no warnings '$warning_type'; $regex;" }
625 ),
626 "... and turning off '$warning_type' warnings suppressed it");
627
628 # Test that whether the warning is on by default is
629 # correct. This test relies on the fact that we
630 # are outside the scope of any ‘use warnings’.
631 local $^W;
632 my @warns = capture_warnings(sub { $_ = "x";
633 eval "$strict $regex" });
634 if ($default_on) {
635 ok @warns > 0, "... and the warning is on by default";
636 }
637 else {
638 ok @warns == 0, "... and the warning is off by default";
639 }
67cdf558 640 }
af01601c
KW
641 }
642 }
b42857f3 643 }
6fe2934b
KW
644 }
645}
b45f050a 646
cb79f740 647done_testing();