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