Commit | Line | Data |
---|---|---|
87a42246 MS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
62a6bb71 | 4 | unshift @INC, 't'; |
9cd8f857 NC |
5 | require Config; |
6 | if (($Config::Config{'extensions'} !~ /\bB\b/) ){ | |
7 | print "1..0 # Skip -- Perl configured without B module\n"; | |
8 | exit 0; | |
9 | } | |
f9d3bdea | 10 | require 'test.pl'; |
87a42246 MS |
11 | } |
12 | ||
87a42246 MS |
13 | use warnings; |
14 | use strict; | |
87a42246 | 15 | |
8b9fb2f9 | 16 | my $tests = 36; # not counting those in the __DATA__ section |
3036b99c | 17 | |
87a42246 | 18 | use B::Deparse; |
09d856fb | 19 | my $deparse = B::Deparse->new(); |
507a68aa | 20 | isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object'); |
4da9a2ca | 21 | my %deparse; |
87a42246 | 22 | |
ad46c0be RH |
23 | $/ = "\n####\n"; |
24 | while (<DATA>) { | |
25 | chomp; | |
d8cf01c3 | 26 | $tests ++; |
e9c69003 NC |
27 | # This code is pinched from the t/lib/common.pl for TODO. |
28 | # It's not clear how to avoid duplication | |
a6087f24 | 29 | my %meta = (context => ''); |
4da9a2ca | 30 | foreach my $what (qw(skip todo context options)) { |
c4a350e6 | 31 | s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; |
b871937f NC |
32 | # If the SKIP reason starts ? then it's taken as a code snippet to |
33 | # evaluate. This provides the flexibility to have conditional SKIPs | |
c4a350e6 NC |
34 | if ($meta{$what} && $meta{$what} =~ s/^\?//) { |
35 | my $temp = eval $meta{$what}; | |
b871937f | 36 | if ($@) { |
c4a350e6 | 37 | die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; |
b871937f | 38 | } |
c4a350e6 | 39 | $meta{$what} = $temp; |
e9c69003 | 40 | } |
e9c69003 NC |
41 | } |
42 | ||
4a4b8592 | 43 | s/^\s*#\s*(.*)$//mg; |
507a68aa NC |
44 | my $desc = $1; |
45 | die "Missing name in test $_" unless defined $desc; | |
e9c69003 | 46 | |
c4a350e6 | 47 | if ($meta{skip}) { |
f9d3bdea | 48 | SKIP: { skip($meta{skip}) }; |
e9c69003 NC |
49 | next; |
50 | } | |
51 | ||
ad46c0be RH |
52 | my ($input, $expected); |
53 | if (/(.*)\n>>>>\n(.*)/s) { | |
54 | ($input, $expected) = ($1, $2); | |
55 | } | |
56 | else { | |
57 | ($input, $expected) = ($_, $_); | |
58 | } | |
87a42246 | 59 | |
4da9a2ca FC |
60 | # parse options if necessary |
61 | my $deparse = $meta{options} | |
62 | ? $deparse{$meta{options}} ||= | |
63 | new B::Deparse split /,/, $meta{options} | |
64 | : $deparse; | |
65 | ||
7ca9974d | 66 | my $coderef = eval "$meta{context};\n" . <<'EOC' . "sub {$input\n}"; |
a6087f24 NC |
67 | # Tell B::Deparse about our ambient pragmas |
68 | my ($hint_bits, $warning_bits, $hinthash); | |
69 | BEGIN { | |
70 | ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); | |
71 | } | |
72 | $deparse->ambient_pragmas ( | |
73 | hint_bits => $hint_bits, | |
74 | warning_bits => $warning_bits, | |
75 | '%^H' => $hinthash, | |
76 | ); | |
77 | EOC | |
87a42246 | 78 | |
c9fa6ae9 | 79 | local $::TODO = $meta{todo}; |
ad46c0be | 80 | if ($@) { |
507a68aa | 81 | is($@, "", "compilation of $desc"); |
ad46c0be RH |
82 | } |
83 | else { | |
84 | my $deparsed = $deparse->coderef2text( $coderef ); | |
31c6271a RD |
85 | my $regex = $expected; |
86 | $regex =~ s/(\S+)/\Q$1/g; | |
87 | $regex =~ s/\s+/\\s+/g; | |
88 | $regex = '^\{\s*' . $regex . '\s*\}$'; | |
b871937f | 89 | |
507a68aa | 90 | like($deparsed, qr/$regex/, $desc); |
87a42246 | 91 | } |
87a42246 MS |
92 | } |
93 | ||
9187b6e4 FC |
94 | # Reset the ambient pragmas |
95 | { | |
96 | my ($b, $w, $h); | |
97 | BEGIN { | |
98 | ($b, $w, $h) = ($^H, ${^WARNING_BITS}, \%^H); | |
99 | } | |
100 | $deparse->ambient_pragmas ( | |
101 | hint_bits => $b, | |
102 | warning_bits => $w, | |
103 | '%^H' => $h, | |
104 | ); | |
105 | } | |
106 | ||
87a42246 | 107 | use constant 'c', 'stuff'; |
507a68aa NC |
108 | is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff', |
109 | 'the subroutine generated by use constant deparses'); | |
87a42246 | 110 | |
09d856fb | 111 | my $a = 0; |
507a68aa NC |
112 | is($deparse->coderef2text(sub{(-1) ** $a }), "{\n (-1) ** \$a;\n}", |
113 | 'anon sub capturing an external lexical'); | |
87a42246 | 114 | |
d989cdac SM |
115 | use constant cr => ['hello']; |
116 | my $string = "sub " . $deparse->coderef2text(\&cr); | |
0707d6cc | 117 | my $val = (eval $string)->() or diag $string; |
507a68aa NC |
118 | is(ref($val), 'ARRAY', 'constant array references deparse'); |
119 | is($val->[0], 'hello', 'and return the correct value'); | |
87a42246 | 120 | |
87a42246 | 121 | my $path = join " ", map { qq["-I$_"] } @INC; |
87a42246 | 122 | |
7cde0a5f | 123 | $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`; |
e69a2255 | 124 | $a =~ s/-e syntax OK\n//g; |
d2bc402e | 125 | $a =~ s/.*possible typo.*\n//; # Remove warning line |
82f96200 | 126 | $a =~ s/.*-i used with no filenames.*\n//; # Remove warning line |
c96cf1c0 | 127 | $b = quotemeta <<'EOF'; |
d2bc402e RGS |
128 | BEGIN { $^I = ".bak"; } |
129 | BEGIN { $^W = 1; } | |
130 | BEGIN { $/ = "\n"; $\ = "\n"; } | |
87a42246 MS |
131 | LINE: while (defined($_ = <ARGV>)) { |
132 | chomp $_; | |
f86ea535 | 133 | our(@F) = split(' ', $_, 0); |
87a42246 MS |
134 | '???'; |
135 | } | |
87a42246 | 136 | EOF |
c96cf1c0 FC |
137 | $b =~ s/our\\\(\\\@F\\\)/our[( ]\@F\\)?/; # accept both our @F and our(@F) |
138 | like($a, qr/$b/, | |
507a68aa | 139 | 'command line flags deparse as BEGIN blocks setting control variables'); |
87a42246 | 140 | |
5b4ee549 NC |
141 | $a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`; |
142 | $a =~ s/-e syntax OK\n//g; | |
6436970c | 143 | is($a, "use constant ('PI', 4);\n", |
5b4ee549 NC |
144 | "Proxy Constant Subroutines must not show up as (incorrect) prototypes"); |
145 | ||
579a54dc | 146 | #Re: perlbug #35857, patch #24505 |
b3980c39 YO |
147 | #handle warnings::register-ed packages properly. |
148 | package B::Deparse::Wrapper; | |
149 | use strict; | |
150 | use warnings; | |
151 | use warnings::register; | |
152 | sub getcode { | |
579a54dc | 153 | my $deparser = B::Deparse->new(); |
b3980c39 YO |
154 | return $deparser->coderef2text(shift); |
155 | } | |
156 | ||
2990415a FR |
157 | package Moo; |
158 | use overload '0+' => sub { 42 }; | |
159 | ||
b3980c39 YO |
160 | package main; |
161 | use strict; | |
162 | use warnings; | |
71c4dbc3 | 163 | use constant GLIPP => 'glipp'; |
2990415a FR |
164 | use constant PI => 4; |
165 | use constant OVERLOADED_NUMIFICATION => bless({}, 'Moo'); | |
3779476a | 166 | use Fcntl qw/O_TRUNC O_APPEND O_EXCL/; |
aaf9c2b2 | 167 | BEGIN { delete $::Fcntl::{O_APPEND}; } |
2990415a | 168 | use POSIX qw/O_CREAT/; |
b3980c39 | 169 | sub test { |
579a54dc RGS |
170 | my $val = shift; |
171 | my $res = B::Deparse::Wrapper::getcode($val); | |
507a68aa NC |
172 | like($res, qr/use warnings/, |
173 | '[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly'); | |
b3980c39 YO |
174 | } |
175 | my ($q,$p); | |
176 | my $x=sub { ++$q,++$p }; | |
177 | test($x); | |
178 | eval <<EOFCODE and test($x); | |
179 | package bar; | |
180 | use strict; | |
181 | use warnings; | |
182 | use warnings::register; | |
183 | package main; | |
184 | 1 | |
185 | EOFCODE | |
186 | ||
d1dc589d FC |
187 | # Exotic sub declarations |
188 | $a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`; | |
189 | $a =~ s/-e syntax OK\n//g; | |
190 | is($a, <<'EOCODG', "sub :::: and sub ::::::"); | |
191 | sub :::: { | |
192 | ||
193 | } | |
194 | sub :::::: { | |
195 | ||
196 | } | |
197 | EOCODG | |
198 | ||
f2734596 HE |
199 | # [perl #117311] |
200 | $a = `$^X $path "-MO=Deparse,-l" -e "map{ eval(0) }()" 2>&1`; | |
201 | $a =~ s/-e syntax OK\n//g; | |
202 | is($a, <<'EOCODH', "[perl #117311] [PATCH] -l option ('#line ...') does not emit ^Ls in the output"); | |
203 | #line 1 "-e" | |
204 | map { | |
205 | #line 1 "-e" | |
206 | eval 0;} (); | |
207 | EOCODH | |
208 | ||
640d5d41 FC |
209 | # [perl #33752] |
210 | { | |
211 | my $code = <<"EOCODE"; | |
212 | { | |
213 | our \$\x{1e1f}\x{14d}\x{14d}; | |
214 | } | |
215 | EOCODE | |
216 | my $deparsed | |
217 | = $deparse->coderef2text(eval "sub { our \$\x{1e1f}\x{14d}\x{14d} }" ); | |
218 | s/$ \n//x for $deparsed, $code; | |
219 | is $deparsed, $code, 'our $funny_Unicode_chars'; | |
220 | } | |
221 | ||
bdabb2d5 FC |
222 | # [perl #62500] |
223 | $a = | |
224 | `$^X $path "-MO=Deparse" -e "BEGIN{*CORE::GLOBAL::require=sub{1}}" 2>&1`; | |
225 | $a =~ s/-e syntax OK\n//g; | |
226 | is($a, <<'EOCODF', "CORE::GLOBAL::require override causing panick"); | |
227 | sub BEGIN { | |
228 | *CORE::GLOBAL::require = sub { | |
229 | 1; | |
230 | } | |
231 | ; | |
232 | } | |
233 | EOCODF | |
234 | ||
894e98ac FC |
235 | # [perl #91384] |
236 | $a = | |
237 | `$^X $path "-MO=Deparse" -e "BEGIN{*Acme::Acme:: = *Acme::}" 2>&1`; | |
238 | like($a, qr/-e syntax OK/, | |
239 | "Deparse does not hang when traversing stash circularities"); | |
240 | ||
bb8996b8 | 241 | # [perl #93990] |
08412a26 | 242 | @] = (); |
73f4c4fe | 243 | is($deparse->coderef2text(sub{ print "foo@{]}" }), |
bb8996b8 | 244 | q<{ |
73f4c4fe | 245 | print "foo@{]}"; |
08412a26 | 246 | }>, 'curly around to interpolate "@{]}"'); |
73f4c4fe | 247 | is($deparse->coderef2text(sub{ print "foo@{-}" }), |
bb8996b8 | 248 | q<{ |
73f4c4fe | 249 | print "foo@-"; |
bb8996b8 HY |
250 | }>, 'no need to curly around to interpolate "@-"'); |
251 | ||
1c74777c FC |
252 | # Strict hints in %^H are mercilessly suppressed |
253 | $a = | |
254 | `$^X $path "-MO=Deparse" -e "use strict; print;" 2>&1`; | |
255 | unlike($a, qr/BEGIN/, | |
256 | "Deparse does not emit strict hh hints"); | |
257 | ||
3036b99c FC |
258 | # ambient_pragmas should not mess with strict settings. |
259 | SKIP: { | |
260 | skip "requires 5.11", 1 unless $] >= 5.011; | |
261 | eval q` | |
3036b99c | 262 | BEGIN { |
d1718a7c | 263 | # Clear out all hints |
3036b99c | 264 | %^H = (); |
d1718a7c | 265 | $^H = 0; |
3036b99c FC |
266 | new B::Deparse -> ambient_pragmas(strict => 'all'); |
267 | } | |
268 | use 5.011; # should enable strict | |
269 | ok !eval '$do_noT_create_a_variable_with_this_name = 1', | |
270 | 'ambient_pragmas do not mess with compiling scope'; | |
271 | `; | |
272 | } | |
273 | ||
93a8ff62 FC |
274 | # multiple statements on format lines |
275 | $a = `$^X $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`; | |
276 | $a =~ s/-e syntax OK\n//g; | |
93a8ff62 FC |
277 | is($a, <<'EOCODH', 'multiple statements on format lines'); |
278 | format STDOUT = | |
279 | @ | |
280 | x(); z() | |
281 | . | |
282 | EOCODH | |
283 | ||
ddb55548 FC |
284 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], |
285 | prog => "format =\n\@\n\$;\n.\n"), | |
286 | <<'EOCODM', '$; on format line'; | |
287 | format STDOUT = | |
288 | @ | |
289 | $; | |
290 | . | |
291 | EOCODM | |
292 | ||
e56a605e FC |
293 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse,-l', $path ], |
294 | prog => "format =\n\@\n\$foo\n.\n"), | |
295 | <<'EOCODM', 'formats with -l'; | |
296 | format STDOUT = | |
297 | @ | |
298 | $foo | |
299 | . | |
300 | EOCODM | |
301 | ||
8b9fb2f9 FC |
302 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
303 | prog => "{ my \$x; format =\n\@\n\$x\n.\n}"), | |
304 | <<'EOCODN', 'formats nested inside blocks'; | |
305 | { | |
306 | my $x; | |
307 | format STDOUT = | |
308 | @ | |
309 | $x | |
310 | . | |
311 | } | |
312 | EOCODN | |
313 | ||
7741ceed FC |
314 | # CORE::format |
315 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "use feature q|:all|;` | |
316 | .qq` my sub format; CORE::format =" -e. 2>&1`; | |
317 | like($a, qr/CORE::format/, 'CORE::format when lex format sub is in scope'); | |
318 | ||
fea7fb25 DM |
319 | # literal big chars under 'use utf8' |
320 | is($deparse->coderef2text(sub{ use utf8; /€/; }), | |
321 | '{ | |
322 | /\x{20ac}/; | |
323 | }', | |
324 | "qr/euro/"); | |
325 | ||
e54915d6 FC |
326 | # STDERR when deparsing sub calls |
327 | # For a short while the output included 'While deparsing' | |
328 | $a = `$^X $path "-MO=Deparse" -e "foo()" 2>&1`; | |
329 | $a =~ s/-e syntax OK\n//g; | |
330 | is($a, <<'EOCODI', 'no extra output when deparsing foo()'); | |
331 | foo(); | |
332 | EOCODI | |
333 | ||
7741ceed FC |
334 | # CORE::no |
335 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
336 | .qq`"use feature q|:all|; my sub no; CORE::no less" 2>&1`; | |
d4f1bfe7 | 337 | like($a, qr/my sub no;\nCORE::no less;/, |
7741ceed FC |
338 | 'CORE::no after my sub no'); |
339 | ||
340 | # CORE::use | |
341 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
342 | .qq`"use feature q|:all|; my sub use; CORE::use less" 2>&1`; | |
d4f1bfe7 | 343 | like($a, qr/my sub use;\nCORE::use less;/, |
7741ceed FC |
344 | 'CORE::use after my sub use'); |
345 | ||
346 | # CORE::__DATA__ | |
347 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
348 | .qq`"use feature q|:all|; my sub __DATA__; ` | |
349 | .qq`CORE::__DATA__" 2>&1`; | |
34b54951 | 350 | like($a, qr/my sub __DATA__;\n.*\nCORE::__DATA__/s, |
7741ceed FC |
351 | 'CORE::__DATA__ after my sub __DATA__'); |
352 | ||
fe8d6c18 FC |
353 | # sub declarations |
354 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "sub foo{}" 2>&1`; | |
dd3f0a7a | 355 | like($a, qr/sub foo\s*\{\s+\}/, 'sub declarations'); |
67359f08 FC |
356 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
357 | prog => 'sub f($); sub f($){}'), | |
358 | qr/sub f\s*\(\$\)\s*\{\s*\}/, | |
359 | 'predeclared prototyped subs'; | |
de001ba0 FC |
360 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
361 | prog => 'use Scalar::Util q-weaken-; | |
362 | sub f($); | |
363 | BEGIN { weaken($_=\$::{f}) }'), | |
364 | qr/sub f\s*\(\$\)\s*;/, | |
365 | 'prototyped stub with weak reference to the stash entry'; | |
fe8d6c18 | 366 | |
8635e3c2 FC |
367 | # BEGIN blocks |
368 | SKIP : { | |
369 | skip "BEGIN output is wrong on old perls", 1 if $] < 5.021006; | |
370 | my $prog = ' | |
371 | BEGIN { pop } | |
372 | { | |
373 | BEGIN { pop } | |
374 | { | |
375 | no overloading; | |
376 | { | |
377 | BEGIN { pop } | |
378 | die | |
379 | } | |
380 | } | |
381 | }'; | |
382 | $prog =~ s/\n//g; | |
383 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "$prog" 2>&1`; | |
384 | $a =~ s/-e syntax OK\n//g; | |
385 | is($a, <<'EOCODJ', 'BEGIN blocks'); | |
386 | sub BEGIN { | |
387 | pop @ARGV; | |
388 | } | |
389 | { | |
390 | sub BEGIN { | |
391 | pop @ARGV; | |
392 | } | |
393 | { | |
394 | no overloading; | |
395 | { | |
396 | sub BEGIN { | |
397 | pop @ARGV; | |
398 | } | |
399 | die; | |
400 | } | |
401 | } | |
402 | } | |
403 | EOCODJ | |
404 | } | |
34b54951 FC |
405 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], prog => ' |
406 | { | |
407 | { | |
408 | die; | |
409 | BEGIN { pop } | |
410 | } | |
411 | BEGIN { pop } | |
412 | } | |
413 | BEGIN { pop } | |
414 | '), <<'EOCODL', 'BEGIN blocks at the end of their enclosing blocks'; | |
415 | { | |
416 | { | |
417 | die; | |
418 | sub BEGIN { | |
419 | pop @ARGV; | |
420 | } | |
34b54951 FC |
421 | } |
422 | sub BEGIN { | |
423 | pop @ARGV; | |
424 | } | |
34b54951 FC |
425 | } |
426 | sub BEGIN { | |
427 | pop @ARGV; | |
428 | } | |
34b54951 | 429 | EOCODL |
93a8ff62 | 430 | |
1f9498d0 | 431 | # [perl #115066] |
1f9498d0 FC |
432 | my $prog = 'use constant FOO => do { 1 }; no overloading; die'; |
433 | $a = readpipe qq`$^X $path "-MO=-qq,Deparse" -e "$prog" 2>&1`; | |
434 | is($a, <<'EOCODK', '[perl #115066] use statements accidentally nested'); | |
435 | use constant ('FOO', do { | |
d88d1fe0 | 436 | 1 |
1f9498d0 FC |
437 | }); |
438 | no overloading; | |
439 | die; | |
440 | EOCODK | |
441 | ||
d49c3562 FC |
442 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
443 | prog => 'use feature lexical_subs=>; my sub f;sub main::f{}'), | |
444 | qr/^sub main::f \{/m, | |
445 | 'sub decl when lex sub is in scope'; | |
446 | ||
d02d1323 FC |
447 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], |
448 | prog => '$x =~ (1?/$a/:0)'), | |
449 | '$x =~ ($_ =~ /$a/);'."\n", | |
450 | '$foo =~ <branch-folded match> under taint mode'; | |
451 | ||
d8cf01c3 | 452 | done_testing($tests); |
507a68aa | 453 | |
ad46c0be | 454 | __DATA__ |
b8346d05 KW |
455 | # TODO [perl #120950] This succeeds when run a 2nd time |
456 | # y/uni/code/ | |
457 | tr/\x{345}/\x{370}/; | |
458 | #### | |
459 | # y/uni/code/ [perl #120950] This 2nd instance succeeds | |
460 | tr/\x{345}/\x{370}/; | |
461 | #### | |
507a68aa | 462 | # A constant |
ad46c0be RH |
463 | 1; |
464 | #### | |
507a68aa | 465 | # Constants in a block |
f5b5c2a3 | 466 | # CONTEXT no warnings; |
ad46c0be | 467 | { |
ad46c0be RH |
468 | '???'; |
469 | 2; | |
470 | } | |
471 | #### | |
507a68aa | 472 | # Lexical and simple arithmetic |
ad46c0be RH |
473 | my $test; |
474 | ++$test and $test /= 2; | |
475 | >>>> | |
476 | my $test; | |
477 | $test /= 2 if ++$test; | |
478 | #### | |
507a68aa | 479 | # list x |
ad46c0be RH |
480 | -((1, 2) x 2); |
481 | #### | |
6a861075 FC |
482 | # Assignment to list x |
483 | ((undef) x 3) = undef; | |
484 | #### | |
507a68aa | 485 | # lvalue sub |
ad46c0be RH |
486 | { |
487 | my $test = sub : lvalue { | |
488 | my $x; | |
489 | } | |
490 | ; | |
491 | } | |
492 | #### | |
507a68aa | 493 | # method |
ad46c0be RH |
494 | { |
495 | my $test = sub : method { | |
496 | my $x; | |
497 | } | |
498 | ; | |
499 | } | |
500 | #### | |
6b6b21da FC |
501 | # anonsub attrs at statement start |
502 | my $x = do { +sub : lvalue { my $y; } }; | |
503 | my $z = do { foo: +sub : method { my $a; } }; | |
504 | #### | |
507a68aa | 505 | # block with continue |
87a42246 | 506 | { |
ad46c0be | 507 | 234; |
f99a63a2 | 508 | } |
ad46c0be RH |
509 | continue { |
510 | 123; | |
87a42246 | 511 | } |
ce4e655d | 512 | #### |
507a68aa | 513 | # lexical and package scalars |
ce4e655d RH |
514 | my $x; |
515 | print $main::x; | |
516 | #### | |
507a68aa | 517 | # lexical and package arrays |
ce4e655d RH |
518 | my @x; |
519 | print $main::x[1]; | |
14a55f98 | 520 | #### |
507a68aa | 521 | # lexical and package hashes |
14a55f98 RH |
522 | my %x; |
523 | $x{warn()}; | |
ad8caead | 524 | #### |
66786896 FC |
525 | # our (LIST) |
526 | our($foo, $bar, $baz); | |
527 | #### | |
56cd2ef8 FC |
528 | # CONTEXT { package Dog } use feature "state"; |
529 | # variables with declared classes | |
530 | my Dog $spot; | |
531 | our Dog $spotty; | |
532 | state Dog $spotted; | |
533 | my Dog @spot; | |
534 | our Dog @spotty; | |
535 | state Dog @spotted; | |
536 | my Dog %spot; | |
537 | our Dog %spotty; | |
538 | state Dog %spotted; | |
539 | my Dog ($foo, @bar, %baz); | |
540 | our Dog ($phoo, @barr, %bazz); | |
541 | state Dog ($fough, @barre, %bazze); | |
542 | #### | |
f3515641 FC |
543 | # local our |
544 | local our $rhubarb; | |
5f4d8496 | 545 | local our($rhu, $barb); |
f3515641 | 546 | #### |
507a68aa | 547 | # <> |
ad8caead RGS |
548 | my $foo; |
549 | $_ .= <ARGV> . <$foo>; | |
cef22867 | 550 | #### |
507a68aa | 551 | # \x{} |
11454c59 | 552 | my $foo = "Ab\x{100}\200\x{200}\237Cd\000Ef\x{1000}\cA\x{2000}\cZ"; |
2a43599b | 553 | my $bar = "\x{100}"; |
4ae52e81 | 554 | #### |
507a68aa | 555 | # s///e |
4ae52e81 | 556 | s/x/'y';/e; |
ef90d20a FC |
557 | s/x/$a;/e; |
558 | s/x/complex_expression();/e; | |
241416b8 | 559 | #### |
507a68aa | 560 | # block |
241416b8 DM |
561 | { my $x; } |
562 | #### | |
507a68aa | 563 | # while 1 |
241416b8 DM |
564 | while (1) { my $k; } |
565 | #### | |
507a68aa | 566 | # trailing for |
241416b8 DM |
567 | my ($x,@a); |
568 | $x=1 for @a; | |
569 | >>>> | |
570 | my($x, @a); | |
0bb5f065 | 571 | $x = 1 foreach (@a); |
241416b8 | 572 | #### |
507a68aa | 573 | # 2 arguments in a 3 argument for |
241416b8 DM |
574 | for (my $i = 0; $i < 2;) { |
575 | my $z = 1; | |
576 | } | |
577 | #### | |
507a68aa | 578 | # 3 argument for |
241416b8 DM |
579 | for (my $i = 0; $i < 2; ++$i) { |
580 | my $z = 1; | |
581 | } | |
582 | #### | |
507a68aa | 583 | # 3 argument for again |
241416b8 DM |
584 | for (my $i = 0; $i < 2; ++$i) { |
585 | my $z = 1; | |
586 | } | |
587 | #### | |
22584011 FC |
588 | # 3-argument for with inverted condition |
589 | for (my $i; not $i;) { | |
590 | die; | |
591 | } | |
592 | for (my $i; not $i; ++$i) { | |
593 | die; | |
594 | } | |
88a758b5 FC |
595 | for (my $a; not +($1 || 2) ** 2;) { |
596 | die; | |
597 | } | |
22584011 FC |
598 | Something_to_put_the_loop_in_void_context(); |
599 | #### | |
507a68aa | 600 | # while/continue |
241416b8 DM |
601 | my $i; |
602 | while ($i) { my $z = 1; } continue { $i = 99; } | |
603 | #### | |
507a68aa | 604 | # foreach with my |
09d856fb | 605 | foreach my $i (1, 2) { |
241416b8 DM |
606 | my $z = 1; |
607 | } | |
608 | #### | |
4da9a2ca FC |
609 | # OPTIONS -p |
610 | # foreach with my under -p | |
611 | foreach my $i (1) { | |
612 | die; | |
613 | } | |
614 | #### | |
507a68aa | 615 | # foreach |
241416b8 DM |
616 | my $i; |
617 | foreach $i (1, 2) { | |
618 | my $z = 1; | |
619 | } | |
620 | #### | |
507a68aa | 621 | # foreach, 2 mys |
241416b8 DM |
622 | my $i; |
623 | foreach my $i (1, 2) { | |
624 | my $z = 1; | |
625 | } | |
626 | #### | |
507a68aa | 627 | # foreach with our |
241416b8 DM |
628 | foreach our $i (1, 2) { |
629 | my $z = 1; | |
630 | } | |
631 | #### | |
507a68aa | 632 | # foreach with my and our |
241416b8 DM |
633 | my $i; |
634 | foreach our $i (1, 2) { | |
635 | my $z = 1; | |
636 | } | |
3ac6e0f9 | 637 | #### |
bcff4148 FC |
638 | # foreach with state |
639 | # CONTEXT use feature "state"; | |
640 | foreach state $i (1, 2) { | |
641 | state $z = 1; | |
642 | } | |
643 | #### | |
507a68aa | 644 | # reverse sort |
3ac6e0f9 RGS |
645 | my @x; |
646 | print reverse sort(@x); | |
647 | #### | |
507a68aa | 648 | # sort with cmp |
3ac6e0f9 RGS |
649 | my @x; |
650 | print((sort {$b cmp $a} @x)); | |
651 | #### | |
507a68aa | 652 | # reverse sort with block |
3ac6e0f9 RGS |
653 | my @x; |
654 | print((reverse sort {$b <=> $a} @x)); | |
36d57d93 | 655 | #### |
507a68aa | 656 | # foreach reverse |
36d57d93 RGS |
657 | our @a; |
658 | print $_ foreach (reverse @a); | |
aae53c41 | 659 | #### |
507a68aa | 660 | # foreach reverse (not inplace) |
aae53c41 RGS |
661 | our @a; |
662 | print $_ foreach (reverse 1, 2..5); | |
f86ea535 | 663 | #### |
507a68aa | 664 | # bug #38684 |
f86ea535 SM |
665 | our @ary; |
666 | @ary = split(' ', 'foo', 0); | |
31c6271a | 667 | #### |
de183bbb FC |
668 | # Split to our array |
669 | our @array = split(//, 'foo', 0); | |
670 | #### | |
ef7999f1 FC |
671 | # Split to my array |
672 | my @array = split(//, 'foo', 0); | |
673 | #### | |
507a68aa | 674 | # bug #40055 |
31c6271a RD |
675 | do { () }; |
676 | #### | |
507a68aa | 677 | # bug #40055 |
31c6271a | 678 | do { my $x = 1; $x }; |
d9002312 | 679 | #### |
507a68aa | 680 | # <20061012113037.GJ25805@c4.convolution.nl> |
d9002312 SM |
681 | my $f = sub { |
682 | +{[]}; | |
683 | } ; | |
8b2d6640 | 684 | #### |
507a68aa | 685 | # bug #43010 |
8b2d6640 FC |
686 | '!@$%'->(); |
687 | #### | |
507a68aa | 688 | # bug #43010 |
8b2d6640 FC |
689 | ::(); |
690 | #### | |
507a68aa | 691 | # bug #43010 |
8b2d6640 FC |
692 | '::::'->(); |
693 | #### | |
507a68aa | 694 | # bug #43010 |
8b2d6640 | 695 | &::::; |
09d856fb | 696 | #### |
1b38d782 FC |
697 | # [perl #77172] |
698 | package rt77172; | |
699 | sub foo {} foo & & & foo; | |
700 | >>>> | |
701 | package rt77172; | |
702 | foo(&{&} & foo()); | |
703 | #### | |
507a68aa | 704 | # variables as method names |
09d856fb CK |
705 | my $bar; |
706 | 'Foo'->$bar('orz'); | |
35a99a08 | 707 | 'Foo'->$bar('orz') = 'a stranger stranger than before'; |
09d856fb | 708 | #### |
507a68aa | 709 | # constants as method names |
09d856fb CK |
710 | 'Foo'->bar('orz'); |
711 | #### | |
507a68aa | 712 | # constants as method names without () |
09d856fb | 713 | 'Foo'->bar; |
0ced6c29 | 714 | #### |
28bfcb02 | 715 | # [perl #47359] "indirect" method call notation |
1bf8bbb0 FC |
716 | our @bar; |
717 | foo{@bar}+1,->foo; | |
718 | (foo{@bar}+1),foo(); | |
719 | foo{@bar}1 xor foo(); | |
720 | >>>> | |
721 | our @bar; | |
722 | (foo { @bar } 1)->foo; | |
723 | (foo { @bar } 1), foo(); | |
724 | foo { @bar } 1 xor foo(); | |
725 | #### | |
e9c69003 | 726 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" |
205fef88 | 727 | # CONTEXT use feature ':5.10'; |
507a68aa | 728 | # say |
7ddd1a01 NC |
729 | say 'foo'; |
730 | #### | |
8f57bb34 | 731 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" |
8f57bb34 NC |
732 | # CONTEXT use 5.10.0; |
733 | # say in the context of use 5.10.0 | |
734 | say 'foo'; | |
735 | #### | |
736 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
8f57bb34 NC |
737 | # say with use 5.10.0 |
738 | use 5.10.0; | |
739 | say 'foo'; | |
740 | >>>> | |
741 | no feature; | |
742 | use feature ':5.10'; | |
743 | say 'foo'; | |
744 | #### | |
745 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
746 | # say with use feature ':5.10'; | |
747 | use feature ':5.10'; | |
748 | say 'foo'; | |
749 | >>>> | |
750 | use feature 'say', 'state', 'switch'; | |
751 | say 'foo'; | |
752 | #### | |
753 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
8f57bb34 NC |
754 | # CONTEXT use feature ':5.10'; |
755 | # say with use 5.10.0 in the context of use feature | |
756 | use 5.10.0; | |
757 | say 'foo'; | |
758 | >>>> | |
759 | no feature; | |
760 | use feature ':5.10'; | |
761 | say 'foo'; | |
762 | #### | |
763 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
764 | # CONTEXT use 5.10.0; | |
765 | # say with use feature ':5.10' in the context of use 5.10.0 | |
766 | use feature ':5.10'; | |
767 | say 'foo'; | |
768 | >>>> | |
769 | say 'foo'; | |
770 | #### | |
771 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
772 | # CONTEXT use feature ':5.15'; | |
773 | # __SUB__ | |
774 | __SUB__; | |
775 | #### | |
776 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
777 | # CONTEXT use 5.15.0; |
778 | # __SUB__ in the context of use 5.15.0 | |
779 | __SUB__; | |
780 | #### | |
781 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
782 | # __SUB__ with use 5.15.0 |
783 | use 5.15.0; | |
784 | __SUB__; | |
785 | >>>> | |
786 | no feature; | |
787 | use feature ':5.16'; | |
788 | __SUB__; | |
789 | #### | |
790 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
791 | # __SUB__ with use feature ':5.15'; | |
792 | use feature ':5.15'; | |
793 | __SUB__; | |
794 | >>>> | |
795 | use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; | |
796 | __SUB__; | |
797 | #### | |
798 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
799 | # CONTEXT use feature ':5.15'; |
800 | # __SUB__ with use 5.15.0 in the context of use feature | |
801 | use 5.15.0; | |
802 | __SUB__; | |
803 | >>>> | |
804 | no feature; | |
805 | use feature ':5.16'; | |
806 | __SUB__; | |
807 | #### | |
808 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
809 | # CONTEXT use 5.15.0; | |
810 | # __SUB__ with use feature ':5.15' in the context of use 5.15.0 | |
811 | use feature ':5.15'; | |
812 | __SUB__; | |
813 | >>>> | |
814 | __SUB__; | |
815 | #### | |
e9c69003 | 816 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 817 | # CONTEXT use feature ':5.10'; |
507a68aa | 818 | # state vars |
0ced6c29 RGS |
819 | state $x = 42; |
820 | #### | |
e9c69003 | 821 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 822 | # CONTEXT use feature ':5.10'; |
507a68aa | 823 | # state var assignment |
7ddd1a01 NC |
824 | { |
825 | my $y = (state $x = 42); | |
826 | } | |
827 | #### | |
e9c69003 | 828 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 829 | # CONTEXT use feature ':5.10'; |
c4a6f826 | 830 | # state vars in anonymous subroutines |
7ddd1a01 NC |
831 | $a = sub { |
832 | state $x; | |
833 | return $x++; | |
834 | } | |
835 | ; | |
644741fd NC |
836 | #### |
837 | # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' | |
507a68aa | 838 | # each @array; |
644741fd NC |
839 | each @ARGV; |
840 | each @$a; | |
841 | #### | |
842 | # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' | |
507a68aa | 843 | # keys @array; values @array |
644741fd NC |
844 | keys @$a if keys @ARGV; |
845 | values @ARGV if values @$a; | |
35925e80 | 846 | #### |
507a68aa | 847 | # Anonymous arrays and hashes, and references to them |
35925e80 RGS |
848 | my $a = {}; |
849 | my $b = \{}; | |
850 | my $c = []; | |
851 | my $d = \[]; | |
9210de83 FR |
852 | #### |
853 | # SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version" | |
0f539b13 | 854 | # CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; |
507a68aa | 855 | # implicit smartmatch in given/when |
9210de83 FR |
856 | given ('foo') { |
857 | when ('bar') { continue; } | |
858 | when ($_ ~~ 'quux') { continue; } | |
859 | default { 0; } | |
860 | } | |
7ecdd211 | 861 | #### |
507a68aa | 862 | # conditions in elsifs (regression in change #33710 which fixed bug #37302) |
7ecdd211 PJ |
863 | if ($a) { x(); } |
864 | elsif ($b) { x(); } | |
865 | elsif ($a and $b) { x(); } | |
866 | elsif ($a or $b) { x(); } | |
867 | else { x(); } | |
03b22f1b | 868 | #### |
507a68aa | 869 | # interpolation in regexps |
03b22f1b RGS |
870 | my($y, $t); |
871 | /x${y}z$t/; | |
227375e1 | 872 | #### |
4a4b8592 | 873 | # TODO new undocumented cpan-bug #33708 |
507a68aa | 874 | # cpan-bug #33708 |
227375e1 RU |
875 | %{$_ || {}} |
876 | #### | |
4a4b8592 | 877 | # TODO hash constants not yet fixed |
507a68aa | 878 | # cpan-bug #33708 |
227375e1 RU |
879 | use constant H => { "#" => 1 }; H->{"#"} |
880 | #### | |
4a4b8592 | 881 | # TODO optimized away 0 not yet fixed |
507a68aa | 882 | # cpan-bug #33708 |
227375e1 | 883 | foreach my $i (@_) { 0 } |
edbe35ea | 884 | #### |
507a68aa | 885 | # tests with not, not optimized |
07f3cdf5 | 886 | my $c; |
edbe35ea VP |
887 | x() unless $a; |
888 | x() if not $a and $b; | |
889 | x() if $a and not $b; | |
890 | x() unless not $a and $b; | |
891 | x() unless $a and not $b; | |
892 | x() if not $a or $b; | |
893 | x() if $a or not $b; | |
894 | x() unless not $a or $b; | |
895 | x() unless $a or not $b; | |
07f3cdf5 VP |
896 | x() if $a and not $b and $c; |
897 | x() if not $a and $b and not $c; | |
898 | x() unless $a and not $b and $c; | |
899 | x() unless not $a and $b and not $c; | |
900 | x() if $a or not $b or $c; | |
901 | x() if not $a or $b or not $c; | |
902 | x() unless $a or not $b or $c; | |
903 | x() unless not $a or $b or not $c; | |
edbe35ea | 904 | #### |
507a68aa | 905 | # tests with not, optimized |
07f3cdf5 | 906 | my $c; |
edbe35ea VP |
907 | x() if not $a; |
908 | x() unless not $a; | |
909 | x() if not $a and not $b; | |
910 | x() unless not $a and not $b; | |
911 | x() if not $a or not $b; | |
912 | x() unless not $a or not $b; | |
07f3cdf5 VP |
913 | x() if not $a and not $b and $c; |
914 | x() unless not $a and not $b and $c; | |
915 | x() if not $a or not $b or $c; | |
916 | x() unless not $a or not $b or $c; | |
917 | x() if not $a and not $b and not $c; | |
918 | x() unless not $a and not $b and not $c; | |
919 | x() if not $a or not $b or not $c; | |
920 | x() unless not $a or not $b or not $c; | |
921 | x() unless not $a or not $b or not $c; | |
edbe35ea | 922 | >>>> |
07f3cdf5 | 923 | my $c; |
edbe35ea VP |
924 | x() unless $a; |
925 | x() if $a; | |
926 | x() unless $a or $b; | |
927 | x() if $a or $b; | |
928 | x() unless $a and $b; | |
07f3cdf5 VP |
929 | x() if $a and $b; |
930 | x() if not $a || $b and $c; | |
931 | x() unless not $a || $b and $c; | |
932 | x() if not $a && $b or $c; | |
933 | x() unless not $a && $b or $c; | |
934 | x() unless $a or $b or $c; | |
935 | x() if $a or $b or $c; | |
936 | x() unless $a and $b and $c; | |
937 | x() if $a and $b and $c; | |
938 | x() unless not $a && $b && $c; | |
71c4dbc3 | 939 | #### |
507a68aa | 940 | # tests that should be constant folded |
71c4dbc3 VP |
941 | x() if 1; |
942 | x() if GLIPP; | |
943 | x() if !GLIPP; | |
944 | x() if GLIPP && GLIPP; | |
945 | x() if !GLIPP || GLIPP; | |
946 | x() if do { GLIPP }; | |
947 | x() if do { no warnings 'void'; 5; GLIPP }; | |
948 | x() if do { !GLIPP }; | |
949 | if (GLIPP) { x() } else { z() } | |
950 | if (!GLIPP) { x() } else { z() } | |
951 | if (GLIPP) { x() } elsif (GLIPP) { z() } | |
952 | if (!GLIPP) { x() } elsif (GLIPP) { z() } | |
953 | if (GLIPP) { x() } elsif (!GLIPP) { z() } | |
954 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } | |
955 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (GLIPP) { t() } | |
956 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (!GLIPP) { t() } | |
957 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (!GLIPP) { t() } | |
958 | >>>> | |
959 | x(); | |
960 | x(); | |
961 | '???'; | |
962 | x(); | |
963 | x(); | |
964 | x(); | |
965 | x(); | |
966 | do { | |
967 | '???' | |
968 | }; | |
969 | do { | |
970 | x() | |
971 | }; | |
972 | do { | |
973 | z() | |
974 | }; | |
975 | do { | |
976 | x() | |
977 | }; | |
978 | do { | |
979 | z() | |
980 | }; | |
981 | do { | |
982 | x() | |
983 | }; | |
984 | '???'; | |
985 | do { | |
986 | t() | |
987 | }; | |
988 | '???'; | |
989 | !1; | |
990 | #### | |
719c50dc RGS |
991 | # TODO constant deparsing has been backed out for 5.12 |
992 | # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" | |
507a68aa | 993 | # tests that shouldn't be constant folded |
ac0f1413 NC |
994 | # It might be fundamentally impossible to make this work on ithreads, in which |
995 | # case the TODO should become a SKIP | |
71c4dbc3 VP |
996 | x() if $a; |
997 | if ($a == 1) { x() } elsif ($b == 2) { z() } | |
998 | if (do { foo(); GLIPP }) { x() } | |
999 | if (do { $a++; GLIPP }) { x() } | |
1000 | >>>> | |
1001 | x() if $a; | |
1002 | if ($a == 1) { x(); } elsif ($b == 2) { z(); } | |
2990415a FR |
1003 | if (do { foo(); GLIPP }) { x(); } |
1004 | if (do { ++$a; GLIPP }) { x(); } | |
1005 | #### | |
0fa4a265 | 1006 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1007 | # tests for deparsing constants |
2990415a FR |
1008 | warn PI; |
1009 | #### | |
0fa4a265 | 1010 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1011 | # tests for deparsing imported constants |
3779476a | 1012 | warn O_TRUNC; |
2990415a | 1013 | #### |
0fa4a265 | 1014 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1015 | # tests for deparsing re-exported constants |
2990415a FR |
1016 | warn O_CREAT; |
1017 | #### | |
0fa4a265 | 1018 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1019 | # tests for deparsing imported constants that got deleted from the original namespace |
aaf9c2b2 | 1020 | warn O_APPEND; |
2990415a | 1021 | #### |
0fa4a265 DM |
1022 | # TODO constant deparsing has been backed out for 5.12 |
1023 | # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" | |
507a68aa | 1024 | # tests for deparsing constants which got turned into full typeglobs |
ac0f1413 NC |
1025 | # It might be fundamentally impossible to make this work on ithreads, in which |
1026 | # case the TODO should become a SKIP | |
2990415a FR |
1027 | warn O_EXCL; |
1028 | eval '@Fcntl::O_EXCL = qw/affe tiger/;'; | |
1029 | warn O_EXCL; | |
1030 | #### | |
0fa4a265 | 1031 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1032 | # tests for deparsing of blessed constant with overloaded numification |
2990415a | 1033 | warn OVERLOADED_NUMIFICATION; |
79289e05 | 1034 | #### |
507a68aa | 1035 | # strict |
79289e05 | 1036 | no strict; |
415d4c68 FC |
1037 | print $x; |
1038 | use strict 'vars'; | |
1039 | print $main::x; | |
1040 | use strict 'subs'; | |
1041 | print $main::x; | |
1042 | use strict 'refs'; | |
1043 | print $main::x; | |
1044 | no strict 'vars'; | |
79289e05 NC |
1045 | $x; |
1046 | #### | |
1047 | # TODO Subsets of warnings could be encoded textually, rather than as bitflips. | |
507a68aa | 1048 | # subsets of warnings |
79289e05 NC |
1049 | no warnings 'deprecated'; |
1050 | my $x; | |
1051 | #### | |
1052 | # TODO Better test for CPAN #33708 - the deparsed code has different behaviour | |
507a68aa | 1053 | # CPAN #33708 |
79289e05 NC |
1054 | use strict; |
1055 | no warnings; | |
1056 | ||
1057 | foreach (0..3) { | |
1058 | my $x = 2; | |
1059 | { | |
1060 | my $x if 0; | |
1061 | print ++$x, "\n"; | |
1062 | } | |
1063 | } | |
d83f38d8 | 1064 | #### |
507a68aa | 1065 | # no attribute list |
d83f38d8 NC |
1066 | my $pi = 4; |
1067 | #### | |
2dc78664 NC |
1068 | # SKIP ?$] > 5.013006 && ":= is now a syntax error" |
1069 | # := treated as an empty attribute list | |
d83f38d8 NC |
1070 | no warnings; |
1071 | my $pi := 4; | |
1072 | >>>> | |
1073 | no warnings; | |
1074 | my $pi = 4; | |
1075 | #### | |
507a68aa | 1076 | # : = empty attribute list |
d83f38d8 NC |
1077 | my $pi : = 4; |
1078 | >>>> | |
1079 | my $pi = 4; | |
689e417f | 1080 | #### |
507a68aa | 1081 | # in place sort |
689e417f VP |
1082 | our @a; |
1083 | my @b; | |
1084 | @a = sort @a; | |
1085 | @b = sort @b; | |
1086 | (); | |
1087 | #### | |
507a68aa | 1088 | # in place reverse |
689e417f VP |
1089 | our @a; |
1090 | my @b; | |
1091 | @a = reverse @a; | |
1092 | @b = reverse @b; | |
1093 | (); | |
06fc6867 | 1094 | #### |
507a68aa | 1095 | # #71870 Use of uninitialized value in bitwise and B::Deparse |
06fc6867 VP |
1096 | my($r, $s, @a); |
1097 | @a = split(/foo/, $s, 0); | |
1098 | $r = qr/foo/; | |
1099 | @a = split(/$r/, $s, 0); | |
1100 | (); | |
98a1a137 | 1101 | #### |
507a68aa | 1102 | # package declaration before label |
98a1a137 Z |
1103 | { |
1104 | package Foo; | |
1105 | label: print 123; | |
1106 | } | |
538f5756 | 1107 | #### |
507a68aa | 1108 | # shift optimisation |
538f5756 RZ |
1109 | shift; |
1110 | >>>> | |
1111 | shift(); | |
1112 | #### | |
507a68aa | 1113 | # shift optimisation |
538f5756 RZ |
1114 | shift @_; |
1115 | #### | |
507a68aa | 1116 | # shift optimisation |
538f5756 RZ |
1117 | pop; |
1118 | >>>> | |
1119 | pop(); | |
1120 | #### | |
507a68aa | 1121 | # shift optimisation |
538f5756 | 1122 | pop @_; |
a539498a | 1123 | #### |
507a68aa | 1124 | #[perl #20444] |
a539498a FC |
1125 | "foo" =~ (1 ? /foo/ : /bar/); |
1126 | "foo" =~ (1 ? y/foo// : /bar/); | |
5e5a1632 | 1127 | "foo" =~ (1 ? y/foo//r : /bar/); |
a539498a FC |
1128 | "foo" =~ (1 ? s/foo// : /bar/); |
1129 | >>>> | |
1130 | 'foo' =~ ($_ =~ /foo/); | |
1131 | 'foo' =~ ($_ =~ tr/fo//); | |
5e5a1632 | 1132 | 'foo' =~ ($_ =~ tr/fo//r); |
a539498a | 1133 | 'foo' =~ ($_ =~ s/foo//); |
e0ab66ad | 1134 | #### |
5e5a1632 FC |
1135 | # The fix for [perl #20444] broke this. |
1136 | 'foo' =~ do { () }; | |
1137 | #### | |
4b58603b FC |
1138 | # [perl #81424] match against aelemfast_lex |
1139 | my @s; | |
1140 | print /$s[1]/; | |
1141 | #### | |
36727b53 FC |
1142 | # /$#a/ |
1143 | print /$#main::a/; | |
1144 | #### | |
9e32885a FC |
1145 | # $lexical =~ // |
1146 | my $x; | |
1147 | $x =~ //; | |
1148 | #### | |
b9bc576f | 1149 | # [perl #91318] /regexp/applaud |
09622ee2 FC |
1150 | print /a/a, s/b/c/a; |
1151 | print /a/aa, s/b/c/aa; | |
1152 | print /a/p, s/b/c/p; | |
1153 | print /a/l, s/b/c/l; | |
1154 | print /a/u, s/b/c/u; | |
b9bc576f FC |
1155 | { |
1156 | use feature "unicode_strings"; | |
09622ee2 | 1157 | print /a/d, s/b/c/d; |
b9bc576f FC |
1158 | } |
1159 | { | |
1160 | use re "/u"; | |
09622ee2 | 1161 | print /a/d, s/b/c/d; |
b9bc576f | 1162 | } |
dff5ffe4 FC |
1163 | { |
1164 | use 5.012; | |
1165 | print /a/d, s/b/c/d; | |
1166 | } | |
b9bc576f | 1167 | >>>> |
09622ee2 FC |
1168 | print /a/a, s/b/c/a; |
1169 | print /a/aa, s/b/c/aa; | |
1170 | print /a/p, s/b/c/p; | |
1171 | print /a/l, s/b/c/l; | |
1172 | print /a/u, s/b/c/u; | |
b9bc576f | 1173 | { |
a8095af7 | 1174 | use feature 'unicode_strings'; |
09622ee2 | 1175 | print /a/d, s/b/c/d; |
b9bc576f FC |
1176 | } |
1177 | { | |
0bb01b05 FC |
1178 | BEGIN { $^H{'reflags'} = '0'; |
1179 | $^H{'reflags_charset'} = '2'; } | |
09622ee2 | 1180 | print /a/d, s/b/c/d; |
b9bc576f | 1181 | } |
dff5ffe4 FC |
1182 | { |
1183 | no feature; | |
1184 | use feature ':5.12'; | |
1185 | print /a/d, s/b/c/d; | |
1186 | } | |
b9bc576f | 1187 | #### |
9f125c4a FC |
1188 | # [perl #119807] s//\(3)/ge should not warn when deparsed (\3 warns) |
1189 | s/foo/\(3);/eg; | |
1190 | #### | |
c9fa6ae9 | 1191 | # [perl #115256] |
c9fa6ae9 FC |
1192 | "" =~ /a(?{ print q| |
1193 | |})/; | |
1194 | >>>> | |
f6b6ee63 | 1195 | '' =~ /a(?{ print "\n"; })/; |
c9fa6ae9 FC |
1196 | #### |
1197 | # [perl #123217] | |
c9fa6ae9 FC |
1198 | $_ = qr/(??{<<END})/ |
1199 | f.o | |
1200 | b.r | |
1201 | END | |
1202 | >>>> | |
1203 | $_ = qr/(??{ "f.o\nb.r\n"; })/; | |
1204 | #### | |
1205 | # More regexp code block madness | |
c9fa6ae9 FC |
1206 | my($b, @a); |
1207 | /(?{ die $b; })/; | |
1208 | /a(?{ die $b; })a/; | |
1209 | /$a(?{ die $b; })/; | |
1210 | /@a(?{ die $b; })/; | |
1211 | /(??{ die $b; })/; | |
1212 | /a(??{ die $b; })a/; | |
1213 | /$a(??{ die $b; })/; | |
1214 | /@a(??{ die $b; })/; | |
1215 | qr/(?{ die $b; })/; | |
1216 | qr/a(?{ die $b; })a/; | |
1217 | qr/$a(?{ die $b; })/; | |
1218 | qr/@a(?{ die $b; })/; | |
1219 | qr/(??{ die $b; })/; | |
1220 | qr/a(??{ die $b; })a/; | |
1221 | qr/$a(??{ die $b; })/; | |
1222 | qr/@a(??{ die $b; })/; | |
1223 | s/(?{ die $b; })//; | |
1224 | s/a(?{ die $b; })a//; | |
1225 | s/$a(?{ die $b; })//; | |
1226 | s/@a(?{ die $b; })//; | |
1227 | s/(??{ die $b; })//; | |
1228 | s/a(??{ die $b; })a//; | |
1229 | s/$a(??{ die $b; })//; | |
1230 | s/@a(??{ die $b; })//; | |
1231 | #### | |
e7afc405 | 1232 | # y///r |
d52196e1 | 1233 | tr/a/b/r + $a =~ tr/p/q/r; |
cb8157e3 | 1234 | #### |
12cea2fa FC |
1235 | # y///d in list [perl #119815] |
1236 | () = tr/a//d; | |
1237 | #### | |
cb8578ff | 1238 | # [perl #90898] |
f4002a4b | 1239 | <a,>; |
09dcfa7d FC |
1240 | #### |
1241 | # [perl #91008] | |
d401967c | 1242 | # CONTEXT no warnings 'experimental::autoderef'; |
09dcfa7d FC |
1243 | each $@; |
1244 | keys $~; | |
1245 | values $!; | |
5d8c42c2 FC |
1246 | #### |
1247 | # readpipe with complex expression | |
1248 | readpipe $a + $b; | |
93bad3fd NC |
1249 | #### |
1250 | # aelemfast | |
1251 | $b::a[0] = 1; | |
1252 | #### | |
1253 | # aelemfast for a lexical | |
1254 | my @a; | |
1255 | $a[0] = 1; | |
80e3f4ad FC |
1256 | #### |
1257 | # feature features without feature | |
0f539b13 | 1258 | # CONTEXT no warnings 'experimental::smartmatch'; |
80e3f4ad | 1259 | CORE::state $x; |
223b1722 FC |
1260 | CORE::say $x; |
1261 | CORE::given ($x) { | |
1262 | CORE::when (3) { | |
1263 | continue; | |
1264 | } | |
1265 | CORE::default { | |
1266 | CORE::break; | |
1267 | } | |
1268 | } | |
1269 | CORE::evalbytes ''; | |
1270 | () = CORE::__SUB__; | |
838f2281 | 1271 | () = CORE::fc $x; |
223b1722 FC |
1272 | #### |
1273 | # feature features when feature has been disabled by use VERSION | |
0f539b13 | 1274 | # CONTEXT no warnings 'experimental::smartmatch'; |
223b1722 FC |
1275 | use feature (sprintf(":%vd", $^V)); |
1276 | use 1; | |
412989c2 | 1277 | CORE::say $_; |
223b1722 | 1278 | CORE::state $x; |
223b1722 FC |
1279 | CORE::given ($x) { |
1280 | CORE::when (3) { | |
1281 | continue; | |
1282 | } | |
1283 | CORE::default { | |
1284 | CORE::break; | |
1285 | } | |
1286 | } | |
1287 | CORE::evalbytes ''; | |
1288 | () = CORE::__SUB__; | |
1289 | >>>> | |
412989c2 | 1290 | CORE::say $_; |
205fef88 | 1291 | CORE::state $x; |
205fef88 NC |
1292 | CORE::given ($x) { |
1293 | CORE::when (3) { | |
1294 | continue; | |
1295 | } | |
1296 | CORE::default { | |
1297 | CORE::break; | |
1298 | } | |
1299 | } | |
1300 | CORE::evalbytes ''; | |
1301 | () = CORE::__SUB__; | |
1302 | #### | |
1303 | # (the above test with CONTEXT, and the output is equivalent but different) | |
0f539b13 | 1304 | # CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; |
205fef88 NC |
1305 | # feature features when feature has been disabled by use VERSION |
1306 | use feature (sprintf(":%vd", $^V)); | |
1307 | use 1; | |
412989c2 | 1308 | CORE::say $_; |
205fef88 | 1309 | CORE::state $x; |
205fef88 NC |
1310 | CORE::given ($x) { |
1311 | CORE::when (3) { | |
1312 | continue; | |
1313 | } | |
1314 | CORE::default { | |
1315 | CORE::break; | |
1316 | } | |
1317 | } | |
1318 | CORE::evalbytes ''; | |
1319 | () = CORE::__SUB__; | |
1320 | >>>> | |
0bb01b05 FC |
1321 | no feature; |
1322 | use feature ':default'; | |
412989c2 | 1323 | CORE::say $_; |
223b1722 | 1324 | CORE::state $x; |
80e3f4ad FC |
1325 | CORE::given ($x) { |
1326 | CORE::when (3) { | |
1327 | continue; | |
1328 | } | |
1329 | CORE::default { | |
e36901c8 | 1330 | CORE::break; |
80e3f4ad FC |
1331 | } |
1332 | } | |
7d789282 | 1333 | CORE::evalbytes ''; |
84ed0108 | 1334 | () = CORE::__SUB__; |
6ec73527 | 1335 | #### |
7741ceed FC |
1336 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" |
1337 | # lexical subroutines and keywords of the same name | |
1338 | # CONTEXT use feature 'lexical_subs', 'switch'; no warnings 'experimental'; | |
1339 | my sub default; | |
1340 | my sub else; | |
1341 | my sub elsif; | |
1342 | my sub for; | |
1343 | my sub foreach; | |
1344 | my sub given; | |
1345 | my sub if; | |
1346 | my sub m; | |
1347 | my sub no; | |
1348 | my sub package; | |
1349 | my sub q; | |
1350 | my sub qq; | |
1351 | my sub qr; | |
1352 | my sub qx; | |
1353 | my sub require; | |
1354 | my sub s; | |
1355 | my sub sub; | |
1356 | my sub tr; | |
1357 | my sub unless; | |
1358 | my sub until; | |
1359 | my sub use; | |
1360 | my sub when; | |
1361 | my sub while; | |
1362 | CORE::default { die; } | |
1363 | CORE::if ($1) { die; } | |
1364 | CORE::if ($1) { die; } | |
1365 | CORE::elsif ($1) { die; } | |
1366 | CORE::else { die; } | |
1367 | CORE::for (die; $1; die) { die; } | |
1368 | CORE::foreach $_ (1 .. 10) { die; } | |
1369 | die CORE::foreach (1); | |
1370 | CORE::given ($1) { die; } | |
1371 | CORE::m[/]; | |
1372 | CORE::m?/?; | |
1373 | CORE::package foo; | |
1374 | CORE::no strict; | |
1375 | () = (CORE::q['], CORE::qq["$_], CORE::qr//, CORE::qx[`]); | |
1376 | CORE::require 1; | |
1377 | CORE::s///; | |
1378 | () = CORE::sub { die; } ; | |
1379 | CORE::tr///; | |
1380 | CORE::unless ($1) { die; } | |
1381 | CORE::until ($1) { die; } | |
1382 | die CORE::until $1; | |
1383 | CORE::use strict; | |
1384 | CORE::when ($1 ~~ $2) { die; } | |
1385 | CORE::while ($1) { die; } | |
1386 | die CORE::while $1; | |
1387 | #### | |
0bb01b05 FC |
1388 | # Feature hints |
1389 | use feature 'current_sub', 'evalbytes'; | |
1390 | print; | |
1391 | use 1; | |
1392 | print; | |
1393 | use 5.014; | |
1394 | print; | |
1395 | no feature 'unicode_strings'; | |
1396 | print; | |
1397 | >>>> | |
a8095af7 | 1398 | use feature 'current_sub', 'evalbytes'; |
0bb01b05 FC |
1399 | print $_; |
1400 | no feature; | |
1401 | use feature ':default'; | |
1402 | print $_; | |
1403 | no feature; | |
1404 | use feature ':5.12'; | |
1405 | print $_; | |
a8095af7 | 1406 | no feature 'unicode_strings'; |
0bb01b05 FC |
1407 | print $_; |
1408 | #### | |
6ec73527 FC |
1409 | # $#- $#+ $#{%} etc. |
1410 | my @x; | |
5b6da579 | 1411 | @x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*}); |
6ec73527 FC |
1412 | @x = ($#{(}, $#{)}, $#{[}, $#{{}, $#{]}, $#{}}, $#{'}, $#{"}, $#{,}); |
1413 | @x = ($#{<}, $#{.}, $#{>}, $#{/}, $#{?}, $#{=}, $#+, $#{\}, $#{|}, $#-); | |
1414 | @x = ($#{;}, $#{:}); | |
61154ac0 | 1415 | #### |
ff683671 NC |
1416 | # ${#} interpolated |
1417 | # It's a known TODO that warnings are deparsed as bits, not textually. | |
1418 | no warnings; | |
61154ac0 | 1419 | () = "${#}a"; |
958ed56b | 1420 | #### |
337d7381 FC |
1421 | # [perl #86060] $( $| $) in regexps need braces |
1422 | /${(}/; | |
1423 | /${|}/; | |
1424 | /${)}/; | |
1425 | /${(}${|}${)}/; | |
1426 | #### | |
958ed56b FC |
1427 | # ()[...] |
1428 | my(@a) = ()[()]; | |
521795fe FC |
1429 | #### |
1430 | # sort(foo(bar)) | |
1431 | # sort(foo(bar)) is interpreted as sort &foo(bar) | |
1432 | # sort foo(bar) is interpreted as sort foo bar | |
1433 | # parentheses are not optional in this case | |
1434 | print sort(foo('bar')); | |
1435 | >>>> | |
1436 | print sort(foo('bar')); | |
24fcb59f FC |
1437 | #### |
1438 | # substr assignment | |
1439 | substr(my $a, 0, 0) = (foo(), bar()); | |
1440 | $a++; | |
04be0204 | 1441 | #### |
d1718a7c FC |
1442 | # This following line works around an unfixed bug that we are not trying to |
1443 | # test for here: | |
1444 | # CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised | |
04be0204 FC |
1445 | # hint hash |
1446 | BEGIN { $^H{'foo'} = undef; } | |
1447 | { | |
1448 | BEGIN { $^H{'bar'} = undef; } | |
1449 | { | |
1450 | BEGIN { $^H{'baz'} = undef; } | |
1451 | { | |
1452 | print $_; | |
1453 | } | |
1454 | print $_; | |
1455 | } | |
1456 | print $_; | |
1457 | } | |
035146a3 FC |
1458 | BEGIN { $^H{q[']} = '('; } |
1459 | print $_; | |
c306e834 | 1460 | #### |
d1718a7c FC |
1461 | # This following line works around an unfixed bug that we are not trying to |
1462 | # test for here: | |
1463 | # CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised | |
c306e834 FC |
1464 | # hint hash changes that serialise the same way with sort %hh |
1465 | BEGIN { $^H{'a'} = 'b'; } | |
1466 | { | |
1467 | BEGIN { $^H{'b'} = 'a'; delete $^H{'a'}; } | |
1468 | print $_; | |
1469 | } | |
1470 | print $_; | |
94bb57f9 FC |
1471 | #### |
1472 | # [perl #47361] do({}) and do +{} (variants of do-file) | |
1473 | do({}); | |
1474 | do +{}; | |
8b46c09b FC |
1475 | sub foo::do {} |
1476 | package foo; | |
1477 | CORE::do({}); | |
1478 | CORE::do +{}; | |
94bb57f9 FC |
1479 | >>>> |
1480 | do({}); | |
1481 | do({}); | |
8b46c09b FC |
1482 | package foo; |
1483 | CORE::do({}); | |
1484 | CORE::do({}); | |
9c56d9ea FC |
1485 | #### |
1486 | # [perl #77096] functions that do not follow the llafr | |
1487 | () = (return 1) + time; | |
1488 | () = (return ($1 + $2) * $3) + time; | |
1489 | () = (return ($a xor $b)) + time; | |
1490 | () = (do 'file') + time; | |
1491 | () = (do ($1 + $2) * $3) + time; | |
1492 | () = (do ($1 xor $2)) + time; | |
41df74e3 FC |
1493 | () = (goto 1) + 3; |
1494 | () = (require 'foo') + 3; | |
1495 | () = (require foo) + 3; | |
266da325 | 1496 | () = (CORE::dump 1) + 3; |
41df74e3 FC |
1497 | () = (last 1) + 3; |
1498 | () = (next 1) + 3; | |
1499 | () = (redo 1) + 3; | |
5830412d FC |
1500 | () = (-R $_) + 3; |
1501 | () = (-W $_) + 3; | |
1502 | () = (-X $_) + 3; | |
1503 | () = (-r $_) + 3; | |
1504 | () = (-w $_) + 3; | |
1505 | () = (-x $_) + 3; | |
2462c3cc | 1506 | #### |
1cabb3b3 FC |
1507 | # [perl #97476] not() *does* follow the llafr |
1508 | $_ = ($a xor not +($1 || 2) ** 2); | |
1509 | #### | |
4d8ac5c7 FC |
1510 | # Precedence conundrums with argument-less function calls |
1511 | () = (eof) + 1; | |
1512 | () = (return) + 1; | |
1513 | () = (return, 1); | |
7bc8c979 FC |
1514 | () = warn; |
1515 | () = warn() + 1; | |
4d8ac5c7 FC |
1516 | () = setpgrp() + 1; |
1517 | #### | |
1eb0b7be FC |
1518 | # loopexes have assignment prec |
1519 | () = (CORE::dump a) | 'b'; | |
1520 | () = (goto a) | 'b'; | |
1521 | () = (last a) | 'b'; | |
1522 | () = (next a) | 'b'; | |
1523 | () = (redo a) | 'b'; | |
1524 | #### | |
2462c3cc FC |
1525 | # [perl #63558] open local(*FH) |
1526 | open local *FH; | |
564cd6cb | 1527 | pipe local *FH, local *FH; |
843b15cc | 1528 | #### |
b89b7257 FC |
1529 | # [perl #91416] open "string" |
1530 | open 'open'; | |
1531 | open '####'; | |
1532 | open '^A'; | |
1533 | open "\ca"; | |
1534 | >>>> | |
1535 | open *open; | |
1536 | open '####'; | |
1537 | open '^A'; | |
1538 | open *^A; | |
1539 | #### | |
be6cf5cf FC |
1540 | # "string"->[] ->{} |
1541 | no strict 'vars'; | |
1542 | () = 'open'->[0]; #aelemfast | |
1543 | () = '####'->[0]; | |
1544 | () = '^A'->[0]; | |
1545 | () = "\ca"->[0]; | |
b861b87f | 1546 | () = 'a::]b'->[0]; |
10e8e32b FC |
1547 | () = 'open'->[$_]; #aelem |
1548 | () = '####'->[$_]; | |
1549 | () = '^A'->[$_]; | |
1550 | () = "\ca"->[$_]; | |
b861b87f | 1551 | () = 'a::]b'->[$_]; |
10e8e32b FC |
1552 | () = 'open'->{0}; #helem |
1553 | () = '####'->{0}; | |
1554 | () = '^A'->{0}; | |
1555 | () = "\ca"->{0}; | |
b861b87f | 1556 | () = 'a::]b'->{0}; |
be6cf5cf | 1557 | >>>> |
415d4c68 | 1558 | no strict 'vars'; |
be6cf5cf FC |
1559 | () = $open[0]; |
1560 | () = '####'->[0]; | |
1561 | () = '^A'->[0]; | |
1562 | () = $^A[0]; | |
b861b87f | 1563 | () = 'a::]b'->[0]; |
10e8e32b FC |
1564 | () = $open[$_]; |
1565 | () = '####'->[$_]; | |
1566 | () = '^A'->[$_]; | |
1567 | () = $^A[$_]; | |
b861b87f | 1568 | () = 'a::]b'->[$_]; |
10e8e32b FC |
1569 | () = $open{'0'}; |
1570 | () = '####'->{'0'}; | |
1571 | () = '^A'->{'0'}; | |
1572 | () = $^A{'0'}; | |
b861b87f | 1573 | () = 'a::]b'->{'0'}; |
be6cf5cf | 1574 | #### |
843b15cc FC |
1575 | # [perl #74740] -(f()) vs -f() |
1576 | $_ = -(f()); | |
c75b4828 FC |
1577 | #### |
1578 | # require <binop> | |
1579 | require 'a' . $1; | |
afb60448 HY |
1580 | #### |
1581 | #[perl #30504] foreach-my postfix/prefix difference | |
1582 | $_ = 'foo' foreach my ($foo1, $bar1, $baz1); | |
1583 | foreach (my ($foo2, $bar2, $baz2)) { $_ = 'foo' } | |
1584 | foreach my $i (my ($foo3, $bar3, $baz3)) { $i = 'foo' } | |
1585 | >>>> | |
1586 | $_ = 'foo' foreach (my($foo1, $bar1, $baz1)); | |
1587 | foreach $_ (my($foo2, $bar2, $baz2)) { | |
1588 | $_ = 'foo'; | |
1589 | } | |
1590 | foreach my $i (my($foo3, $bar3, $baz3)) { | |
1591 | $i = 'foo'; | |
1592 | } | |
1593 | #### | |
1594 | #[perl #108224] foreach with continue block | |
1595 | foreach (1 .. 3) { print } continue { print "\n" } | |
1596 | foreach (1 .. 3) { } continue { } | |
1597 | foreach my $i (1 .. 3) { print $i } continue { print "\n" } | |
1598 | foreach my $i (1 .. 3) { } continue { } | |
1599 | >>>> | |
1600 | foreach $_ (1 .. 3) { | |
1601 | print $_; | |
1602 | } | |
1603 | continue { | |
1604 | print "\n"; | |
1605 | } | |
1606 | foreach $_ (1 .. 3) { | |
1607 | (); | |
1608 | } | |
1609 | continue { | |
1610 | (); | |
1611 | } | |
1612 | foreach my $i (1 .. 3) { | |
1613 | print $i; | |
1614 | } | |
1615 | continue { | |
1616 | print "\n"; | |
1617 | } | |
1618 | foreach my $i (1 .. 3) { | |
1619 | (); | |
1620 | } | |
1621 | continue { | |
1622 | (); | |
1623 | } | |
bc1cc2c3 DM |
1624 | #### |
1625 | # file handles | |
1626 | no strict; | |
1627 | my $mfh; | |
1628 | open F; | |
1629 | open *F; | |
1630 | open $fh; | |
1631 | open $mfh; | |
1632 | open 'a+b'; | |
1633 | select *F; | |
1634 | select F; | |
1635 | select $f; | |
1636 | select $mfh; | |
1637 | select 'a+b'; | |
a7fd8ef6 DM |
1638 | #### |
1639 | # 'my' works with padrange op | |
1640 | my($z, @z); | |
1641 | my $m1; | |
1642 | $m1 = 1; | |
1643 | $z = $m1; | |
1644 | my $m2 = 2; | |
1645 | my($m3, $m4); | |
1646 | ($m3, $m4) = (1, 2); | |
1647 | @z = ($m3, $m4); | |
1648 | my($m5, $m6) = (1, 2); | |
1649 | my($m7, undef, $m8) = (1, 2, 3); | |
1650 | @z = ($m7, undef, $m8); | |
1651 | ($m7, undef, $m8) = (1, 2, 3); | |
1652 | #### | |
1653 | # 'our/local' works with padrange op | |
a7fd8ef6 DM |
1654 | our($z, @z); |
1655 | our $o1; | |
0298c760 | 1656 | no strict; |
a7fd8ef6 DM |
1657 | local $o11; |
1658 | $o1 = 1; | |
1659 | local $o1 = 1; | |
1660 | $z = $o1; | |
1661 | $z = local $o1; | |
1662 | our $o2 = 2; | |
1663 | our($o3, $o4); | |
1664 | ($o3, $o4) = (1, 2); | |
1665 | local($o3, $o4) = (1, 2); | |
1666 | @z = ($o3, $o4); | |
1667 | @z = local($o3, $o4); | |
1668 | our($o5, $o6) = (1, 2); | |
1669 | our($o7, undef, $o8) = (1, 2, 3); | |
1670 | @z = ($o7, undef, $o8); | |
1671 | @z = local($o7, undef, $o8); | |
1672 | ($o7, undef, $o8) = (1, 2, 3); | |
1673 | local($o7, undef, $o8) = (1, 2, 3); | |
1674 | #### | |
1675 | # 'state' works with padrange op | |
412989c2 | 1676 | # CONTEXT no strict; use feature 'state'; |
a7fd8ef6 DM |
1677 | state($z, @z); |
1678 | state $s1; | |
1679 | $s1 = 1; | |
1680 | $z = $s1; | |
1681 | state $s2 = 2; | |
1682 | state($s3, $s4); | |
1683 | ($s3, $s4) = (1, 2); | |
1684 | @z = ($s3, $s4); | |
1685 | # assignment of state lists isn't implemented yet | |
1686 | #state($s5, $s6) = (1, 2); | |
1687 | #state($s7, undef, $s8) = (1, 2, 3); | |
1688 | #@z = ($s7, undef, $s8); | |
1689 | ($s7, undef, $s8) = (1, 2, 3); | |
1690 | #### | |
df2b00e8 | 1691 | # anon arrays with padrange |
a7fd8ef6 DM |
1692 | my($a, $b); |
1693 | my $c = [$a, $b]; | |
1694 | my $d = {$a, $b}; | |
1695 | #### | |
1696 | # slices with padrange | |
1697 | my($a, $b); | |
1698 | my(@x, %y); | |
1699 | @x = @x[$a, $b]; | |
1700 | @x = @y{$a, $b}; | |
1701 | #### | |
1702 | # binops with padrange | |
1703 | my($a, $b, $c); | |
1704 | $c = $a cmp $b; | |
1705 | $c = $a + $b; | |
1706 | $a += $b; | |
1707 | $c = $a - $b; | |
1708 | $a -= $b; | |
1709 | $c = my $a1 cmp $b; | |
1710 | $c = my $a2 + $b; | |
1711 | $a += my $b1; | |
1712 | $c = my $a3 - $b; | |
1713 | $a -= my $b2; | |
1714 | #### | |
1715 | # 'x' with padrange | |
1716 | my($a, $b, $c, $d, @e); | |
1717 | $c = $a x $b; | |
1718 | $a x= $b; | |
1719 | @e = ($a) x $d; | |
1720 | @e = ($a, $b) x $d; | |
1721 | @e = ($a, $b, $c) x $d; | |
1722 | @e = ($a, 1) x $d; | |
d5524600 DM |
1723 | #### |
1724 | # @_ with padrange | |
1725 | my($a, $b, $c) = @_; | |
ce4062e7 AC |
1726 | #### |
1727 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" | |
ce4062e7 AC |
1728 | # lexical subroutine |
1729 | use feature 'lexical_subs'; | |
601448c3 | 1730 | no warnings "experimental::lexical_subs"; |
ce4062e7 AC |
1731 | my sub f {} |
1732 | print f(); | |
d4f1bfe7 FC |
1733 | >>>> |
1734 | use feature 'lexical_subs'; | |
1735 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUUU\005"} | |
1736 | my sub f { | |
1737 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUU\005"} | |
1738 | ||
1739 | } | |
1740 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUU\005"} | |
1741 | print f(); | |
f0cf3754 AC |
1742 | #### |
1743 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" | |
f0cf3754 AC |
1744 | # lexical "state" subroutine |
1745 | use feature 'state', 'lexical_subs'; | |
1746 | no warnings 'experimental::lexical_subs'; | |
1747 | state sub f {} | |
1748 | print f(); | |
d4f1bfe7 FC |
1749 | >>>> |
1750 | use feature 'lexical_subs'; | |
1751 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUUU\005"} | |
1752 | CORE::state sub f { | |
1753 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUU\005"} | |
1754 | use feature 'state'; | |
1755 | ||
1756 | } | |
1757 | BEGIN {${^WARNING_BITS} = "TUUUUUUUUUUUUTUU\005"} | |
1758 | use feature 'state'; | |
1759 | print f(); | |
bcbe2b27 | 1760 | #### |
8443930e | 1761 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" |
8443930e FC |
1762 | # lexical subroutine scoping |
1763 | # CONTEXT use feature 'lexical_subs'; no warnings 'experimental::lexical_subs'; | |
1764 | { | |
1765 | { | |
1766 | my sub a { die; } | |
1767 | { | |
1768 | foo(); | |
1769 | my sub b; | |
1770 | b(); | |
1771 | main::b(); | |
d49c3562 FC |
1772 | &main::b; |
1773 | &main::b(); | |
1774 | my $b = \&main::b; | |
1775 | sub b { $b; } | |
8443930e FC |
1776 | } |
1777 | } | |
1778 | b(); | |
1779 | } | |
1780 | #### | |
bcbe2b27 FC |
1781 | # Elements of %# should not be confused with $#{ array } |
1782 | () = ${#}{'foo'}; | |
c4cf781e | 1783 | #### |
ddb55548 FC |
1784 | # $; [perl #12335] |
1785 | $_ = $;; | |
1786 | do { | |
1787 | $; | |
1788 | }; | |
1789 | #### | |
c4cf781e FC |
1790 | # [perl #121050] Prototypes with whitespace |
1791 | sub _121050(\$ \$) { } | |
1792 | _121050($a,$b); | |
1793 | sub _121050empty( ) {} | |
1794 | () = _121050empty() + 1; | |
1795 | >>>> | |
1796 | _121050 $a, $b; | |
1797 | () = _121050empty + 1; | |
b024352e | 1798 | #### |
c65b7c4d FC |
1799 | # Ampersand calls and scalar context |
1800 | # OPTIONS -P | |
1801 | package prototest; | |
1802 | sub foo($$); | |
1803 | foo(bar(),baz()); | |
1804 | >>>> | |
1805 | package prototest; | |
1806 | &foo(scalar bar(), scalar baz()); | |
1807 | #### | |
b024352e DM |
1808 | # ensure aelemfast works in the range -128..127 and that there's no |
1809 | # funky edge cases | |
1810 | my $x; | |
1811 | no strict 'vars'; | |
1812 | $x = $a[-256] + $a[-255] + $a[-129] + $a[-128] + $a[-127] + $a[-1] + $a[0]; | |
1813 | $x = $a[1] + $a[126] + $a[127] + $a[128] + $a[255] + $a[256]; | |
1814 | my @b; | |
1815 | $x = $b[-256] + $b[-255] + $b[-129] + $b[-128] + $b[-127] + $b[-1] + $b[0]; | |
1816 | $x = $b[1] + $b[126] + $b[127] + $b[128] + $b[255] + $b[256]; | |
e09d73a6 DIM |
1817 | #### |
1818 | # 'm' must be preserved in m?? | |
1819 | m??; | |
c8ec376c FC |
1820 | #### |
1821 | # \(@array) and \(..., (@array), ...) | |
1822 | my(@array, %hash, @a, @b, %c, %d); | |
1823 | () = \(@array); | |
1824 | () = \(%hash); | |
1825 | () = \(@a, (@b), (%c), %d); | |
1826 | () = \(@Foo::array); | |
1827 | () = \(%Foo::hash); | |
1828 | () = \(@Foo::a, (@Foo::b), (%Foo::c), %Foo::d); | |
a958cfbb FC |
1829 | #### |
1830 | # subs synonymous with keywords | |
1831 | main::our(); | |
1832 | main::pop(); | |
1833 | state(); | |
1834 | use feature 'state'; | |
1835 | main::state(); | |
9187b6e4 FC |
1836 | #### |
1837 | # lvalue references | |
baabe3fb | 1838 | # CONTEXT use feature "state", 'refaliasing', 'lexical_subs'; no warnings 'experimental'; |
9187b6e4 FC |
1839 | our $x; |
1840 | \$x = \$x; | |
1841 | my $m; | |
1842 | \$m = \$x; | |
1843 | \my $n = \$x; | |
1844 | (\$x) = @_; | |
1845 | \($x) = @_; | |
1846 | \($m) = @_; | |
1847 | (\$m) = @_; | |
1848 | \my($p) = @_; | |
1849 | (\my $r) = @_; | |
1850 | \($x, my $a) = @{[\$x, \$x]}; | |
1851 | (\$x, \my $b) = @{[\$x, \$x]}; | |
1852 | \local $x = \3; | |
1853 | \local($x) = \3; | |
1854 | \state $c = \3; | |
1855 | \state($d) = \3; | |
1856 | \our $e = \3; | |
1857 | \our($f) = \3; | |
1858 | \$_[0] = foo(); | |
1859 | \($_[1]) = foo(); | |
1860 | my @a; | |
1861 | \$a[0] = foo(); | |
1862 | \($a[1]) = foo(); | |
1863 | \local($a[1]) = foo(); | |
1864 | \@a[0,1] = foo(); | |
1865 | \(@a[2,3]) = foo(); | |
1866 | \local @a[0,1] = (\$a)x2; | |
1867 | \$_{a} = foo(); | |
1868 | \($_{b}) = foo(); | |
1869 | my %h; | |
1870 | \$h{a} = foo(); | |
1871 | \($h{b}) = foo(); | |
1872 | \local $h{a} = \$x; | |
1873 | \local($h{b}) = \$x; | |
1874 | \@h{'a','b'} = foo(); | |
1875 | \(@h{2,3}) = foo(); | |
1876 | \local @h{'a','b'} = (\$x)x2; | |
1877 | \@_ = foo(); | |
1878 | \@a = foo(); | |
1879 | (\@_) = foo(); | |
1880 | (\@a) = foo(); | |
1881 | \my @c = foo(); | |
1882 | (\my @d) = foo(); | |
1883 | \(@_) = foo(); | |
1884 | \(@a) = foo(); | |
1885 | \my(@g) = foo(); | |
1886 | \local @_ = \@_; | |
1887 | (\local @_) = \@_; | |
1888 | \state @e = [1..3]; | |
1889 | \state(@f) = \3; | |
1890 | \our @i = [1..3]; | |
1891 | \our(@h) = \3; | |
1892 | \%_ = foo(); | |
1893 | \%h = foo(); | |
1894 | (\%_) = foo(); | |
1895 | (\%h) = foo(); | |
1896 | \my %c = foo(); | |
1897 | (\my %d) = foo(); | |
1898 | \local %_ = \%h; | |
1899 | (\local %_) = \%h; | |
1900 | \state %y = {1,2}; | |
1901 | \our %z = {1,2}; | |
1902 | (\our %zz) = {1,2}; | |
1903 | \&a = foo(); | |
1904 | (\&a) = foo(); | |
1905 | \(&a) = foo(); | |
1906 | { | |
1907 | my sub a; | |
1908 | \&a = foo(); | |
1909 | (\&a) = foo(); | |
1910 | \(&a) = foo(); | |
1911 | } | |
1912 | (\$_, $_) = \(1, 2); | |
1913 | $_ == 3 ? \$_ : $_ = \3; | |
1914 | $_ == 3 ? \$_ : \$x = \3; | |
1915 | \($_ == 3 ? $_ : $x) = \3; | |
1916 | for \my $topic (\$1, \$2) { | |
1917 | die; | |
1918 | } | |
1919 | for \state $topic (\$1, \$2) { | |
1920 | die; | |
1921 | } | |
1922 | for \our $topic (\$1, \$2) { | |
1923 | die; | |
1924 | } | |
1925 | for \$_ (\$1, \$2) { | |
1926 | die; | |
1927 | } | |
1928 | for \my @a ([1,2], [3,4]) { | |
1929 | die; | |
1930 | } | |
1931 | for \state @a ([1,2], [3,4]) { | |
1932 | die; | |
1933 | } | |
1934 | for \our @a ([1,2], [3,4]) { | |
1935 | die; | |
1936 | } | |
1937 | for \@_ ([1,2], [3,4]) { | |
1938 | die; | |
1939 | } | |
1940 | for \my %a ({5,6}, {7,8}) { | |
1941 | die; | |
1942 | } | |
1943 | for \our %a ({5,6}, {7,8}) { | |
1944 | die; | |
1945 | } | |
1946 | for \state %a ({5,6}, {7,8}) { | |
1947 | die; | |
1948 | } | |
1949 | for \%_ ({5,6}, {7,8}) { | |
1950 | die; | |
1951 | } | |
1952 | { | |
1953 | my sub a; | |
1954 | for \&a (sub { 9; }, sub { 10; }) { | |
1955 | die; | |
1956 | } | |
1957 | } | |
1958 | for \&a (sub { 9; }, sub { 10; }) { | |
1959 | die; | |
1960 | } | |
1961 | >>>> | |
1962 | our $x; | |
1963 | \$x = \$x; | |
1964 | my $m; | |
1965 | \$m = \$x; | |
1966 | \my $n = \$x; | |
1967 | (\$x) = @_; | |
1968 | (\$x) = @_; | |
1969 | (\$m) = @_; | |
1970 | (\$m) = @_; | |
1971 | (\my $p) = @_; | |
1972 | (\my $r) = @_; | |
1973 | (\$x, \my $a) = @{[\$x, \$x];}; | |
1974 | (\$x, \my $b) = @{[\$x, \$x];}; | |
1975 | \local $x = \3; | |
1976 | (\local $x) = \3; | |
1977 | \state $c = \3; | |
1978 | (\state $d) = \3; | |
1979 | \our $e = \3; | |
1980 | (\our $f) = \3; | |
1981 | \$_[0] = foo(); | |
1982 | (\$_[1]) = foo(); | |
1983 | my @a; | |
1984 | \$a[0] = foo(); | |
1985 | (\$a[1]) = foo(); | |
1986 | (\local $a[1]) = foo(); | |
1987 | (\@a[0, 1]) = foo(); | |
1988 | (\@a[2, 3]) = foo(); | |
1989 | (\local @a[0, 1]) = (\$a) x 2; | |
1990 | \$_{'a'} = foo(); | |
1991 | (\$_{'b'}) = foo(); | |
1992 | my %h; | |
1993 | \$h{'a'} = foo(); | |
1994 | (\$h{'b'}) = foo(); | |
1995 | \local $h{'a'} = \$x; | |
1996 | (\local $h{'b'}) = \$x; | |
1997 | (\@h{'a', 'b'}) = foo(); | |
1998 | (\@h{2, 3}) = foo(); | |
1999 | (\local @h{'a', 'b'}) = (\$x) x 2; | |
2000 | \@_ = foo(); | |
2001 | \@a = foo(); | |
2002 | (\@_) = foo(); | |
2003 | (\@a) = foo(); | |
2004 | \my @c = foo(); | |
2005 | (\my @d) = foo(); | |
2006 | (\(@_)) = foo(); | |
2007 | (\(@a)) = foo(); | |
2008 | (\(my @g)) = foo(); | |
2009 | \local @_ = \@_; | |
2010 | (\local @_) = \@_; | |
2011 | \state @e = [1..3]; | |
2012 | (\(state @f)) = \3; | |
2013 | \our @i = [1..3]; | |
2014 | (\(our @h)) = \3; | |
2015 | \%_ = foo(); | |
2016 | \%h = foo(); | |
2017 | (\%_) = foo(); | |
2018 | (\%h) = foo(); | |
2019 | \my %c = foo(); | |
2020 | (\my %d) = foo(); | |
2021 | \local %_ = \%h; | |
2022 | (\local %_) = \%h; | |
2023 | \state %y = {1, 2}; | |
2024 | \our %z = {1, 2}; | |
2025 | (\our %zz) = {1, 2}; | |
2026 | \&a = foo(); | |
2027 | (\&a) = foo(); | |
2028 | (\&a) = foo(); | |
2029 | { | |
2030 | my sub a; | |
2031 | \&a = foo(); | |
2032 | (\&a) = foo(); | |
2033 | (\&a) = foo(); | |
2034 | } | |
2035 | (\$_, $_) = \(1, 2); | |
2036 | $_ == 3 ? \$_ : $_ = \3; | |
2037 | $_ == 3 ? \$_ : \$x = \3; | |
2038 | ($_ == 3 ? \$_ : \$x) = \3; | |
2039 | foreach \my $topic (\$1, \$2) { | |
2040 | die; | |
2041 | } | |
2042 | foreach \state $topic (\$1, \$2) { | |
2043 | die; | |
2044 | } | |
2045 | foreach \our $topic (\$1, \$2) { | |
2046 | die; | |
2047 | } | |
2048 | foreach \$_ (\$1, \$2) { | |
2049 | die; | |
2050 | } | |
2051 | foreach \my @a ([1, 2], [3, 4]) { | |
2052 | die; | |
2053 | } | |
2054 | foreach \state @a ([1, 2], [3, 4]) { | |
2055 | die; | |
2056 | } | |
2057 | foreach \our @a ([1, 2], [3, 4]) { | |
2058 | die; | |
2059 | } | |
2060 | foreach \@_ ([1, 2], [3, 4]) { | |
2061 | die; | |
2062 | } | |
2063 | foreach \my %a ({5, 6}, {7, 8}) { | |
2064 | die; | |
2065 | } | |
2066 | foreach \our %a ({5, 6}, {7, 8}) { | |
2067 | die; | |
2068 | } | |
2069 | foreach \state %a ({5, 6}, {7, 8}) { | |
2070 | die; | |
2071 | } | |
2072 | foreach \%_ ({5, 6}, {7, 8}) { | |
2073 | die; | |
2074 | } | |
2075 | { | |
2076 | my sub a; | |
2077 | foreach \&a (sub { 9; } , sub { 10; } ) { | |
2078 | die; | |
2079 | } | |
2080 | } | |
2081 | foreach \&a (sub { 9; } , sub { 10; } ) { | |
2082 | die; | |
2083 | } | |
3b4e2a4d FC |
2084 | #### |
2085 | # join $foo, pos | |
2086 | my $foo; | |
2087 | $_ = join $foo, pos | |
2088 | >>>> | |
2089 | my $foo; | |
2090 | $_ = join('???', pos $_); | |
fedf30e1 DM |
2091 | #### |
2092 | # exists $a[0] | |
2093 | our @a; | |
2094 | exists $a[0]; | |
2095 | #### | |
2096 | # my @a; exists $a[0] | |
2097 | my @a; | |
2098 | exists $a[0]; | |
2099 | #### | |
2100 | # delete $a[0] | |
2101 | our @a; | |
2102 | delete $a[0]; | |
2103 | #### | |
2104 | # my @a; delete $a[0] | |
2105 | my @a; | |
2106 | delete $a[0]; | |
2107 | #### | |
2108 | # $_[0][$_[1]] | |
2109 | $_[0][$_[1]]; | |
2110 | #### | |
2111 | # f($a[0]); | |
2112 | my @a; | |
2113 | f($a[0]); | |
2114 | #### | |
2115 | #qr/\Q$h{'key'}\E/; | |
2116 | my %h; | |
2117 | qr/\Q$h{'key'}\E/; | |
2118 | #### | |
2119 | # my $x = "$h{foo}"; | |
2120 | my %h; | |
2121 | my $x = "$h{'foo'}"; | |
2122 | #### | |
2123 | # weird constant hash key | |
2124 | my %h; | |
2125 | my $x = $h{"\000\t\x{100}"}; | |
2126 | #### | |
2127 | # multideref and packages | |
2128 | package foo; | |
2129 | my(%bar) = ('a', 'b'); | |
2130 | our(@bar) = (1, 2); | |
2131 | $bar{'k'} = $bar[200]; | |
2132 | $main::bar{'k'} = $main::bar[200]; | |
2133 | $foo::bar{'k'} = $foo::bar[200]; | |
2134 | package foo2; | |
2135 | $bar{'k'} = $bar[200]; | |
2136 | $main::bar{'k'} = $main::bar[200]; | |
2137 | $foo::bar{'k'} = $foo::bar[200]; | |
2138 | >>>> | |
2139 | package foo; | |
2140 | my(%bar) = ('a', 'b'); | |
2141 | our(@bar) = (1, 2); | |
2142 | $bar{'k'} = $bar[200]; | |
2143 | $main::bar{'k'} = $main::bar[200]; | |
2144 | $foo::bar{'k'} = $bar[200]; | |
2145 | package foo2; | |
2146 | $bar{'k'} = $foo::bar[200]; | |
2147 | $main::bar{'k'} = $main::bar[200]; | |
2148 | $foo::bar{'k'} = $foo::bar[200]; | |
2149 | #### | |
2150 | # multideref and local | |
2151 | my %h; | |
2152 | local $h{'foo'}[0] = 1; | |
2153 | #### | |
2154 | # multideref and exists | |
2155 | my(%h, $i); | |
2156 | my $e = exists $h{'foo'}[$i]; | |
2157 | #### | |
2158 | # multideref and delete | |
2159 | my(%h, $i); | |
2160 | my $e = delete $h{'foo'}[$i]; | |
2161 | #### | |
2162 | # multideref with leading expression | |
2163 | my $r; | |
2164 | my $x = ($r // [])->{'foo'}[0]; | |
2165 | #### | |
2166 | # multideref with complex middle index | |
2167 | my(%h, $i, $j, $k); | |
2168 | my $x = $h{'foo'}[$i + $j]{$k}; |