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