This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
in re_op_compile(), keep code_blocks for qr//
[perl5.git] / t / re / pat_re_eval.t
CommitLineData
0f289c68
YO
1#!./perl
2#
3# This is a home for regular expression tests that don't fit into
4# the format supported by re/regexp.t. If you want to add a test
5# that does fit that format, add it to re/re_tests, not here.
6
7use strict;
8use warnings;
9use 5.010;
10
11
12sub run_tests;
13
14$| = 1;
15
16
17BEGIN {
18 chdir 't' if -d 't';
19 @INC = ('../lib','.');
90b541eb 20 require './test.pl';
0669fd04 21 skip_all_if_miniperl("no dynamic loading on miniperl, no re");
0f289c68
YO
22}
23
24
947535e3 25plan tests => 242; # Update this when adding/deleting tests.
0f289c68
YO
26
27run_tests() unless caller;
28
29#
30# Tests start here.
31#
32sub run_tests {
33 {
f245da07 34 my $message = "Call code from qr //";
0f289c68
YO
35 local $_ = 'var="foo"';
36 $a = qr/(?{++$b})/;
37 $b = 7;
f245da07 38 ok(/$a$a/ && $b eq '9', $message);
0f289c68
YO
39
40 my $c="$a";
f245da07 41 ok(/$a$a/ && $b eq '11', $message);
0f289c68
YO
42
43 undef $@;
44 eval {/$c/};
f245da07 45 like($@, qr/not allowed at runtime/, $message);
0f289c68
YO
46
47 use re "eval";
48 /$a$c$a/;
f245da07 49 is($b, '14', $message);
0f289c68
YO
50
51 our $lex_a = 43;
52 our $lex_b = 17;
53 our $lex_c = 27;
54 my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
55
f245da07
NC
56 is($lex_res, 1, $message);
57 is($lex_a, 44, $message);
58 is($lex_c, 43, $message);
0f289c68
YO
59
60 no re "eval";
61 undef $@;
62 my $match = eval { /$a$c$a/ };
f245da07
NC
63 ok($@ && $@ =~ /Eval-group not allowed/ && !$match, $message);
64 is($b, '14', $message);
0f289c68
YO
65
66 $lex_a = 2;
67 $lex_a = 43;
68 $lex_b = 17;
69 $lex_c = 27;
70 $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
71
f245da07
NC
72 is($lex_res, 1, $message);
73 is($lex_a, 44, $message);
74 is($lex_c, 43, $message);
0f289c68
YO
75
76 }
77
78 {
79 our $a = bless qr /foo/ => 'Foo';
80 ok 'goodfood' =~ $a, "Reblessed qr // matches";
de26e0cc 81 is($a, '(?^:foo)', "Reblessed qr // stringifies");
0f289c68
YO
82 my $x = "\x{3fe}";
83 my $z = my $y = "\317\276"; # Byte representation of $x
84 $a = qr /$x/;
85 ok $x =~ $a, "UTF-8 interpolation in qr //";
86 ok "a$a" =~ $x, "Stringified qr // preserves UTF-8";
87 ok "a$x" =~ /^a$a\z/, "Interpolated qr // preserves UTF-8";
88 ok "a$x" =~ /^a(??{$a})\z/,
89 "Postponed interpolation of qr // preserves UTF-8";
bb535cf1
NC
90
91
92 is(length qr /##/x, 9, "## in qr // doesn't corrupt memory; Bug 17776");
93
0f289c68
YO
94 {
95 use re 'eval';
96 ok "$x$x" =~ /^$x(??{$x})\z/,
97 "Postponed UTF-8 string in UTF-8 re matches UTF-8";
98 ok "$y$x" =~ /^$y(??{$x})\z/,
99 "Postponed UTF-8 string in non-UTF-8 re matches UTF-8";
100 ok "$y$x" !~ /^$y(??{$y})\z/,
101 "Postponed non-UTF-8 string in non-UTF-8 re doesn't match UTF-8";
102 ok "$x$x" !~ /^$x(??{$y})\z/,
103 "Postponed non-UTF-8 string in UTF-8 re doesn't match UTF-8";
104 ok "$y$y" =~ /^$y(??{$y})\z/,
105 "Postponed non-UTF-8 string in non-UTF-8 re matches non-UTF8";
106 ok "$x$y" =~ /^$x(??{$y})\z/,
107 "Postponed non-UTF-8 string in UTF-8 re matches non-UTF8";
108
109 $y = $z; # Reset $y after upgrade.
110 ok "$x$y" !~ /^$x(??{$x})\z/,
111 "Postponed UTF-8 string in UTF-8 re doesn't match non-UTF-8";
112 ok "$y$y" !~ /^$y(??{$x})\z/,
113 "Postponed UTF-8 string in non-UTF-8 re doesn't match non-UTF-8";
114 }
115 }
116
117
118 {
119 use re 'eval';
f245da07 120 # Test if $^N and $+ work in (?{{})
0f289c68
YO
121 our @ctl_n = ();
122 our @plus = ();
123 our $nested_tags;
124 $nested_tags = qr{
125 <
126 ((\w)+)
127 (?{
128 push @ctl_n, (defined $^N ? $^N : "undef");
129 push @plus, (defined $+ ? $+ : "undef");
130 })
131 >
132 (??{$nested_tags})*
133 </\s* \w+ \s*>
134 }x;
135
136
137 my $c = 0;
138 for my $test (
139 # Test structure:
140 # [ Expected result, Regex, Expected value(s) of $^N, Expected value(s) of $+ ]
141 [ 1, qr#^$nested_tags$#, "bla blubb bla", "a b a" ],
142 [ 1, qr#^($nested_tags)$#, "bla blubb <bla><blubb></blubb></bla>", "a b a" ],
143 [ 1, qr#^(|)$nested_tags$#, "bla blubb bla", "a b a" ],
144 [ 1, qr#^(?:|)$nested_tags$#, "bla blubb bla", "a b a" ],
145 [ 1, qr#^<(bl|bla)>$nested_tags<(/\1)>$#, "blubb /bla", "b /bla" ],
146 [ 1, qr#(??{"(|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
147 [ 1, qr#^(??{"(bla|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
148 [ 1, qr#^(??{"(|)"})(??{$nested_tags})$#, "bla blubb undef", "a b undef" ],
149 [ 1, qr#^(??{"(?:|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
150 [ 1, qr#^((??{"(?:bla|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
151 [ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
152 [ 1, qr#^((??{"(?:|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
153 [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],
154
155 ) { #"#silence vim highlighting
156 $c++;
157 @ctl_n = ();
158 @plus = ();
159 my $match = (("<bla><blubb></blubb></bla>" =~ $test->[1]) ? 1 : 0);
160 push @ctl_n, (defined $^N ? $^N : "undef");
161 push @plus, (defined $+ ? $+ : "undef");
162 ok($test->[0] == $match, "match $c");
163 if ($test->[0] != $match) {
164 # unset @ctl_n and @plus
165 @ctl_n = @plus = ();
166 }
de26e0cc
NC
167 is("@ctl_n", $test->[2], "ctl_n $c");
168 is("@plus", $test->[3], "plus $c");
0f289c68
YO
169 }
170 }
171
172 {
173 use re 'eval';
bb535cf1 174
0f289c68
YO
175
176 our $f;
177 local $f;
178 $f = sub {
179 defined $_[0] ? $_[0] : "undef";
180 };
181
4b0d13b9 182 like("123", qr/^(\d)(((??{1 + $^N})))+$/, 'Bug 56194');
0f289c68
YO
183
184 our @ctl_n;
185 our @plus;
186
187 my $re = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})#;
188 my $re2 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})(|a(b)c|def)(??{"$^R"})#;
189 my $re3 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})(|a(b)c|def)(??{"$^R"})#;
190 our $re5;
191 local $re5 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})#;
192 my $re6 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
193 my $re7 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
194 my $re8 = qr/(\d+)/;
195 my $c = 0;
196 for my $test (
197 # Test structure:
198 # [
199 # String to match
200 # Regex too match
201 # Expected values of $^N
202 # Expected values of $+
203 # Expected values of $1, $2, $3, $4 and $5
204 # ]
205 [
206 "1233",
207 qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(??{$^N})$#,
208 "1 2 3 3",
209 "1 2 3 3",
210 "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
211 ],
212 [
213 "1233",
214 qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$+})$#,
215 "1 2 3 3",
216 "1 2 3 3",
217 "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
218 ],
219 [
220 "1233",
221 qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$+})$#,
222 "1 2 3 3",
223 "1 2 3 3",
224 "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
225 ],
226 [
227 "1233",
228 qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$^N})$#,
229 "1 2 3 3",
230 "1 2 3 3",
231 "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
232 ],
233 [
234 "1233",
235 qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$^N})$#,
236 "1 2 3 3",
237 "1 2 3 3",
238 "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
239 ],
240 [
241 "123abc3",
242 qr#^($re)(|a(b)c|def)(??{$^R})$#,
243 "1 2 3 abc",
244 "1 2 3 b",
245 "\$1 = 123, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
246 ],
247 [
248 "123abc3",
249 qr#^($re2)$#,
250 "1 2 3 123abc3",
251 "1 2 3 b",
252 "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
253 ],
254 [
255 "123abc3",
256 qr#^($re3)$#,
257 "1 2 123abc3",
258 "1 2 b",
259 "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
260 ],
261 [
262 "123abc3",
263 qr#^(??{$re5})(|abc|def)(??{"$^R"})$#,
264 "1 2 abc",
265 "1 2 abc",
266 "\$1 = abc, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef",
267 ],
268 [
269 "123abc3",
270 qr#^(??{$re5})(|a(b)c|def)(??{"$^R"})$#,
271 "1 2 abc",
272 "1 2 b",
273 "\$1 = abc, \$2 = b, \$3 = undef, \$4 = undef, \$5 = undef",
274 ],
275 [
276 "1234",
277 qr#^((\d+)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})))$#,
278 "1234 123 12 1 2 3 1234",
279 "1234 123 12 1 2 3 4",
280 "\$1 = 1234, \$2 = 1, \$3 = 2, \$4 = 3, \$5 = 4",
281 ],
282 [
283 "1234556",
284 qr#^(\d+)($re6)($re6)($re6)$re6(($re6)$re6)$#,
285 "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 56",
286 "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 5",
287 "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 56",
288 ],
289 [
290 "12345562",
291 qr#^((??{$re8}))($re7)($re7)($re7)$re7($re7)($re7(\2))$#,
292 "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 62",
293 "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 2",
294 "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 5",
295 ],
296 ) {
297 $c++;
298 @ctl_n = ();
299 @plus = ();
300 undef $^R;
301 my $match = $test->[0] =~ $test->[1];
302 my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5));
303 push @ctl_n, $f->($^N);
304 push @plus, $f->($+);
bb535cf1 305 ok($match, "match $c; Bug 56194");
0f289c68
YO
306 if (not $match) {
307 # unset $str, @ctl_n and @plus
308 $str = "";
309 @ctl_n = @plus = ();
310 }
bb535cf1
NC
311 is("@ctl_n", $test->[2], "ctl_n $c; Bug 56194");
312 is("@plus", $test->[3], "plus $c; Bug 56194");
313 is($str, $test->[4], "str $c; Bug 56194");
0f289c68
YO
314 }
315 SKIP: {
316 if ($] le '5.010') {
317 skip "test segfaults on perl < 5.10", 4;
318 }
319
320 @ctl_n = ();
321 @plus = ();
322
323 our $re4;
324 local $re4 = qr#(1)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})){2}(?{$^N})(|abc|def)(??{"$^R"})#;
325 undef $^R;
326 my $match = "123abc3" =~ m/^(??{$re4})$/;
327 my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5),'$^R = '.$f->($^R));
328 push @ctl_n, $f->($^N);
329 push @plus, $f->($+);
4b0d13b9 330 ok($match, 'Bug 56194');
0f289c68
YO
331 if (not $match) {
332 # unset $str
333 @ctl_n = ();
334 @plus = ();
335 $str = "";
336 }
4b0d13b9
NC
337 is("@ctl_n", "1 2 undef", 'Bug 56194');
338 is("@plus", "1 2 undef", 'Bug 56194');
339 is($str,
340 "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = undef",
341 'Bug 56194');
0f289c68
YO
342 }
343 }
344
d3cec5e5
DM
345 {
346 # re evals within \U, \Q etc shouldn't be seen by the lexer
347 local our $a = "i";
348 local our $B = "J";
349 ok('(?{1})' =~ /^\Q(?{1})\E$/, '\Q(?{1})\E');
350 ok('(?{1})' =~ /^\Q(?{\E1\}\)$/, '\Q(?{\E1\}\)');
351 use re 'eval';
352 ok('Ia' =~ /^\U(??{"$a\Ea"})$/, '^\U(??{"$a\Ea"})$');
353 ok('ja' =~ /^\L(??{"$B\Ea"})$/, '^\L(??{"$B\Ea"})$');
354 }
355
a39c66b9
DM
356 {
357 # Comprehensive (hopefully) tests of closure behaviour:
358 # i.e. when do (?{}) blocks get (re)compiled, and what instances
359 # of lexical vars do they close over?
360
361 # XXX remove this when TODOs are fixed
362 # like ok, but 1st arg indicates TODO
363 sub tok($$$) {
364 my $todo = shift;
365 local $::TODO = 're_eval lexical madness' if $todo;
366 ok($_[0], $_[1]);
367 }
368
369 # XXX remove this when TODOs are fixed
370 no warnings qw(uninitialized closure);
371
947535e3
DM
372 # if the pattern string gets utf8 upgraded while concatenating,
373 # make sure a literal code block is still detected (by still
374 # compiling in the absence of use re 'eval')
375
376 {
377 my $s1 = "\x{80}";
378 my $s2 = "\x{100}";
379 ok("\x{80}\x{100}" =~ /^$s1(?{1})$s2$/, "utf8 upgrade");
380 }
381
a39c66b9
DM
382 my ($cr1, $cr2, $cr3, $cr4);
383
384 use re 'eval';
385 for my $x (qw(a b c)) {
386 my $bc = ($x ne 'a');
2bd8e0da 387 my $c80 = chr(0x80);
a39c66b9
DM
388
389 # the most basic: literal code should be in same scope
390 # as the parent
391
2bd8e0da
DM
392 ok("A$x" =~ /^A(??{$x})$/, "[$x] literal code");
393 ok("\x{100}$x" =~ /^\x{100}(??{$x})$/, "[$x] literal code UTF8");
a39c66b9
DM
394
395 # the "don't recompile if pattern unchanged" mechanism
396 # shouldn't apply to code blocks - recompile every time
397 # to pick up new instances of variables
398
2bd8e0da
DM
399 my $code1 = 'B(??{$x})';
400 my $code1u = $c80 . "\x{100}" . '(??{$x})';
401 tok($bc, "AB$x" =~ /^A$code1$/, "[$x] unvarying runtime code AA");
402 tok($bc, "A$c80\x{100}$x" =~ /^A$code1u$/,
403 "[$x] unvarying runtime code AU");
404 tok($bc, "$c80\x{100}B$x" =~ /^$c80\x{100}$code1$/,
405 "[$x] unvarying runtime code UA");
406 tok($bc, "$c80\x{101}$c80\x{100}$x" =~ /^$c80\x{101}$code1u$/,
407 "[$x] unvarying runtime code UU");
a39c66b9
DM
408
409 # mixed literal and run-time code blocks
410
2bd8e0da
DM
411 my $code2 = 'B(??{$x})';
412 my $code2u = $c80 . "\x{100}" . '(??{$x})';
413 tok($bc, "A$x-B$x" =~ /^A(??{$x})-$code2$/,
414 "[$x] literal+runtime AA");
415 tok($bc, "A$x-$c80\x{100}$x" =~ /^A(??{$x})-$code2u$/,
416 "[$x] literal+runtime AU");
417 tok($bc, "$c80\x{100}$x-B$x" =~ /^$c80\x{100}(??{$x})-$code2$/,
418 "[$x] literal+runtime UA");
419 tok($bc, "$c80\x{101}$x-$c80\x{100}$x"
420 =~ /^$c80\x{101}(??{$x})-$code2u$/,
421 "[$x] literal+runtime UU");
a39c66b9
DM
422
423 # literal qr code only created once, naked
424
425 $cr1 //= qr/^A(??{$x})$/;
d63c20f2 426 ok("Aa" =~ $cr1, "[$x] literal qr once naked");
a39c66b9
DM
427
428 # literal qr code only created once, embedded with text
429
430 $cr2 //= qr/B(??{$x})$/;
346d3070 431 ok("ABa" =~ /^A$cr2/, "[$x] literal qr once embedded text");
a39c66b9
DM
432
433 # literal qr code only created once, embedded with text + lit code
434
435 $cr3 //= qr/C(??{$x})$/;
346d3070 436 ok("A$x-BCa" =~ /^A(??{$x})-B$cr3/,
a39c66b9
DM
437 "[$x] literal qr once embedded text + lit code");
438
439 # literal qr code only created once, embedded with text + run code
440
441 $cr4 //= qr/C(??{$x})$/;
442 my $code3 = 'A(??{$x})';
443 tok(1, "A$x-BCa" =~ /^A$code3-B$cr4/,
444 "[$x] literal qr once embedded text + run code");
445
446 # literal qr code, naked
447
448 my $r1 = qr/^A(??{$x})$/;
d63c20f2 449 ok("A$x" =~ $r1, "[$x] literal qr naked");
a39c66b9
DM
450
451 # literal qr code, embedded with text
452
453 my $r2 = qr/B(??{$x})$/;
454 tok($bc, "AB$x" =~ /^A$r2/, "[$x] literal qr embedded text");
455
456 # literal qr code, embedded with text + lit code
457
458 my $r3 = qr/C(??{$x})$/;
459 tok($bc, "A$x-BC$x" =~ /^A(??{$x})-B$r3/,
460 "[$x] literal qr embedded text + lit code");
461
462 # literal qr code, embedded with text + run code
463
464 my $r4 = qr/C(??{$x})$/;
465 my $code4 = '(??{$x})';
466 tok($bc, "A$x-BC$x" =~ /^A$code4-B$r4/,
467 "[$x] literal qr embedded text + run code");
468
469 # nested qr in different scopes
470
471 my $code5 = '(??{$x})';
472 my $r5 = qr/C(??{$x})$/;
473 my $r6 = qr/$code5-C(??{$x})$/;
474
475 my @rr5;
476 my @rr6;
477
478 for my $y (qw(d e f)) {
479
480 my $rr5 = qr/^A(??{"$x$y"})-$r5/;
481 push @rr5, $rr5;
346d3070 482 tok($bc, "A$x$y-C$x" =~ $rr5,
a39c66b9
DM
483 "[$x-$y] literal qr + r5");
484
485 my $rr6 = qr/^A(??{"$x$y"})-$r6/;
486 push @rr6, $rr6;
346d3070 487 tok($bc, "A$x$y-$x-C$x" =~ $rr6,
a39c66b9
DM
488 "[$x-$y] literal qr + r6");
489 }
490
491 for my $i (0,1,2) {
492 my $y = 'Y';
493 my $yy = (qw(d e f))[$i];
494 my $rr5 = $rr5[$i];
346d3070 495 tok($bc, "A$x$yy-C$x" =~ $rr5,
a39c66b9
DM
496 "[$x-$yy] literal qr + r5, outside");
497 tok(1, "A$x$yy-C$x-D$x" =~ /$rr5-D(??{$x})/,
498 "[$x-$yy] literal qr + r5 + lit, outside");
499
500 my $rr6 = $rr6[$i];
501 push @rr6, $rr6;
346d3070 502 tok($bc, "A$x$yy-$x-C$x" =~ $rr6,
a39c66b9
DM
503 "[$x-$yy] literal qr + r6, outside");
504 tok(1, "A$x$yy-$x-C$x-D$x" =~ /$rr6-D(??{$x})/,
505 "[$x-$yy] literal qr + r6 +lit, outside");
506 }
507 }
68e2671b
DM
508
509 # recursive subs should get lexical from the correct pad depth
510
511 sub recurse {
512 my ($n) = @_;
513 return if $n > 2;
514 ok("A$n" =~ /^A(??{$n})$/, "recurse($n)");
515 recurse($n+1);
516 }
517 recurse(0);
d63c20f2
DM
518
519 # for qr// containing run-time elements but with a compile-time
520 # code block, make sure the run-time bits are executed in the same
521 # pad they were compiled in
522 {
523 my $a = 'a'; # ensure outer and inner pads don't align
524 my $b = 'b';
525 my $c = 'c';
526 my $d = 'd';
527 my $r = qr/^$b(??{$c})$d$/;
528 ok("bcd" =~ $r, "qr with run-time elements and code block");
529 }
530
531 # forward declared subs should Do The Right Thing with any anon CVs
532 # within them (i.e. pad_fixup_inner_anons() should work)
533
534 sub forward;
535 sub forward {
536 my $x = "a";
537 my $A = "A";
538 ok("Aa" =~ qr/^A(??{$x})$/, "forward qr compiletime");
539 ok("Aa" =~ qr/^$A(??{$x})$/, "forward qr runtime");
540 }
541 forward;
a39c66b9
DM
542 }
543
0f289c68
YO
544} # End of sub run_tests
545
5461;