B-DeparseTree
view release on metacpan or search on metacpan
t/testdata/P522.pm view on Meta::CPAN
::();
####
# bug #43010
'::::'->();
####
# bug #43010
&::::;
####
# [perl #77172]
package rt77172;
sub foo {} foo & & & foo;
>>>>
package rt77172;
foo(&{&} & foo());
####
# variables as method names
my $bar;
'Foo'->$bar('orz');
'Foo'->$bar('orz') = 'a stranger stranger than before';
####
# constants as method names
'Foo'->bar('orz');
####
# constants as method names without ()
'Foo'->bar;
####
# [perl #47359] "indirect" method call notation
our @bar;
foo{@bar}+1,->foo;
(foo{@bar}+1),foo();
foo{@bar}1 xor foo();
>>>>
our @bar;
(foo { @bar } 1)->foo;
(foo { @bar } 1), foo();
foo { @bar } 1 xor foo();
####
# indirops with blocks
# CONTEXT use 5.01;
print {*STDOUT;} 'foo';
printf {*STDOUT;} 'foo';
say {*STDOUT;} 'foo';
system {'foo';} '-foo';
exec {'foo';} '-foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# CONTEXT use feature ':5.10';
# say
say 'foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# CONTEXT use 5.10.0;
# say in the context of use 5.10.0
say 'foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# say with use 5.10.0
use 5.10.0;
say 'foo';
>>>>
no feature ':all';
use feature ':5.10';
say 'foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# say with use feature ':5.10';
use feature ':5.10';
say 'foo';
>>>>
use feature 'say', 'state', 'switch';
say 'foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# CONTEXT use feature ':5.10';
# say with use 5.10.0 in the context of use feature
use 5.10.0;
say 'foo';
>>>>
no feature ':all';
use feature ':5.10';
say 'foo';
####
# SKIP ?$] < 5.010 && "say not implemented on this Perl version"
# CONTEXT use 5.10.0;
# say with use feature ':5.10' in the context of use 5.10.0
use feature ':5.10';
say 'foo';
>>>>
say 'foo';
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# CONTEXT use feature ':5.15';
# __SUB__
__SUB__;
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# CONTEXT use 5.15.0;
# __SUB__ in the context of use 5.15.0
__SUB__;
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# __SUB__ with use 5.15.0
use 5.15.0;
__SUB__;
>>>>
no feature ':all';
use feature ':5.16';
__SUB__;
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# __SUB__ with use feature ':5.15';
use feature ':5.15';
__SUB__;
>>>>
use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval';
__SUB__;
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# CONTEXT use feature ':5.15';
# __SUB__ with use 5.15.0 in the context of use feature
use 5.15.0;
__SUB__;
>>>>
no feature ':all';
use feature ':5.16';
__SUB__;
####
# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version"
# CONTEXT use 5.15.0;
# __SUB__ with use feature ':5.15' in the context of use 5.15.0
use feature ':5.15';
__SUB__;
>>>>
__SUB__;
####
# SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
# CONTEXT use feature ':5.10';
# state vars
state $x = 42;
####
# SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
# CONTEXT use feature ':5.10';
# state var assignment
{
my $y = (state $x = 42);
}
####
# SKIP ?$] < 5.010 && "state vars not implemented on this Perl version"
# CONTEXT use feature ':5.10';
# state vars in anonymous subroutines
$a = sub {
state $x;
return $x++;
}
;
####
# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
# each @array;
each @ARGV;
each @$a;
####
# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
# keys @array; values @array
keys @$a if keys @ARGV;
values @ARGV if values @$a;
####
# Anonymous arrays and hashes, and references to them
my $a = {};
my $b = \{};
my $c = [];
my $d = \[];
####
# SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version"
# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch';
# implicit smartmatch in given/when
given ('foo') {
when ('bar') { continue; }
when ($_ ~~ 'quux') { continue; }
default { 0; }
}
####
# conditions in elsifs (regression in change #33710 which fixed bug #37302)
if ($a) { x(); }
elsif ($b) { x(); }
t/testdata/P522.pm view on Meta::CPAN
####
# [perl #81424] match against aelemfast_lex
my @s;
print /$s[1]/;
####
# /$#a/
print /$#main::a/;
####
# /@array/
our @a;
my @b;
print /@a/;
print /@b/;
print qr/@a/;
print qr/@b/;
####
# =~ QR_CONSTANT
use constant QR_CONSTANT => qr/a/soupmix;
'' =~ QR_CONSTANT;
>>>>
'' =~ /a/impsux;
####
# $lexical =~ //
my $x;
$x =~ //;
####
# [perl #91318] /regexp/applaud
print /a/a, s/b/c/a;
print /a/aa, s/b/c/aa;
print /a/p, s/b/c/p;
print /a/l, s/b/c/l;
print /a/u, s/b/c/u;
{
use feature "unicode_strings";
print /a/d, s/b/c/d;
}
{
use re "/u";
print /a/d, s/b/c/d;
}
{
use 5.012;
print /a/d, s/b/c/d;
}
>>>>
print /a/a, s/b/c/a;
print /a/aa, s/b/c/aa;
print /a/p, s/b/c/p;
print /a/l, s/b/c/l;
print /a/u, s/b/c/u;
{
use feature 'unicode_strings';
print /a/d, s/b/c/d;
}
{
BEGIN { $^H{'reflags'} = '0';
$^H{'reflags_charset'} = '2'; }
print /a/d, s/b/c/d;
}
{
no feature ':all';
use feature ':5.12';
print /a/d, s/b/c/d;
}
####
# [perl #119807] s//\(3)/ge should not warn when deparsed (\3 warns)
s/foo/\(3);/eg;
####
# [perl #115256]
"" =~ /a(?{ print q|
|})/;
>>>>
'' =~ /a(?{ print "\n"; })/;
####
# [perl #123217]
$_ = qr/(??{<<END})/
f.o
b.r
END
>>>>
$_ = qr/(??{ "f.o\nb.r\n"; })/;
####
# More regexp code block madness
my($b, @a);
/(?{ die $b; })/;
/a(?{ die $b; })a/;
/$a(?{ die $b; })/;
/@a(?{ die $b; })/;
/(??{ die $b; })/;
/a(??{ die $b; })a/;
/$a(??{ die $b; })/;
/@a(??{ die $b; })/;
qr/(?{ die $b; })/;
qr/a(?{ die $b; })a/;
qr/$a(?{ die $b; })/;
qr/@a(?{ die $b; })/;
qr/(??{ die $b; })/;
qr/a(??{ die $b; })a/;
qr/$a(??{ die $b; })/;
qr/@a(??{ die $b; })/;
s/(?{ die $b; })//;
s/a(?{ die $b; })a//;
s/$a(?{ die $b; })//;
s/@a(?{ die $b; })//;
s/(??{ die $b; })//;
s/a(??{ die $b; })a//;
s/$a(??{ die $b; })//;
s/@a(??{ die $b; })//;
####
# /(?x)<newline><tab>/
/(?x)
/;
####
# y///r
tr/a/b/r + $a =~ tr/p/q/r;
####
# y///d in list [perl #119815]
() = tr/a//d;
####
# [perl #90898]
<a,>;
t/testdata/P522.pm view on Meta::CPAN
CORE::given ($x) {
CORE::when (3) {
continue;
}
CORE::default {
CORE::break;
}
}
CORE::evalbytes '';
() = CORE::__SUB__;
() = CORE::fc $x;
####
# feature features when feature has been disabled by use VERSION
# CONTEXT no warnings 'experimental::smartmatch';
use feature (sprintf(":%vd", $^V));
use 1;
CORE::say $_;
CORE::state $x;
CORE::given ($x) {
CORE::when (3) {
continue;
}
CORE::default {
CORE::break;
}
}
CORE::evalbytes '';
() = CORE::__SUB__;
>>>>
CORE::say $_;
CORE::state $x;
CORE::given ($x) {
CORE::when (3) {
continue;
}
CORE::default {
CORE::break;
}
}
CORE::evalbytes '';
() = CORE::__SUB__;
####
# (the above test with CONTEXT, and the output is equivalent but different)
# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch';
# feature features when feature has been disabled by use VERSION
use feature (sprintf(":%vd", $^V));
use 1;
CORE::say $_;
CORE::state $x;
CORE::given ($x) {
CORE::when (3) {
continue;
}
CORE::default {
CORE::break;
}
}
CORE::evalbytes '';
() = CORE::__SUB__;
>>>>
no feature ':all';
use feature ':default';
CORE::say $_;
CORE::state $x;
CORE::given ($x) {
CORE::when (3) {
continue;
}
CORE::default {
CORE::break;
}
}
CORE::evalbytes '';
() = CORE::__SUB__;
####
# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
# lexical subroutines and keywords of the same name
# CONTEXT use feature 'lexical_subs', 'switch'; no warnings 'experimental';
my sub default;
my sub else;
my sub elsif;
my sub for;
my sub foreach;
my sub given;
my sub if;
my sub m;
my sub no;
my sub package;
my sub q;
my sub qq;
my sub qr;
my sub qx;
my sub require;
my sub s;
my sub sub;
my sub tr;
my sub unless;
my sub until;
my sub use;
my sub when;
my sub while;
CORE::default { die; }
CORE::if ($1) { die; }
CORE::if ($1) { die; }
CORE::elsif ($1) { die; }
CORE::else { die; }
CORE::for (die; $1; die) { die; }
CORE::foreach $_ (1 .. 10) { die; }
die CORE::foreach (1);
CORE::given ($1) { die; }
CORE::m[/];
CORE::m?/?;
CORE::package foo;
CORE::no strict;
() = (CORE::q['], CORE::qq["$_], CORE::qr//, CORE::qx[`]);
CORE::require 1;
CORE::s///;
() = CORE::sub { die; } ;
CORE::tr///;
CORE::unless ($1) { die; }
CORE::until ($1) { die; }
die CORE::until $1;
CORE::use strict;
CORE::when ($1 ~~ $2) { die; }
CORE::while ($1) { die; }
die CORE::while $1;
####
# Feature hints
use feature 'current_sub', 'evalbytes';
print;
use 1;
print;
use 5.014;
print;
no feature 'unicode_strings';
print;
>>>>
use feature 'current_sub', 'evalbytes';
print $_;
no feature ':all';
use feature ':default';
print $_;
no feature ':all';
use feature ':5.12';
print $_;
no feature 'unicode_strings';
print $_;
####
# $#- $#+ $#{%} etc.
my @x;
@x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*});
@x = ($#{(}, $#{)}, $#{[}, $#{{}, $#{]}, $#{}}, $#{'}, $#{"}, $#{,});
@x = ($#{<}, $#{.}, $#{>}, $#{/}, $#{?}, $#{=}, $#+, $#{\}, $#{|}, $#-);
@x = ($#{;}, $#{:}, $#{1}), $#_;
####
# [perl #86060] $( $| $) in regexps need braces
/${(}/;
/${|}/;
/${)}/;
/${(}${|}${)}/;
/@{+}@{-}/;
####
# ()[...]
my(@a) = ()[()];
####
# sort(foo(bar))
# sort(foo(bar)) is interpreted as sort &foo(bar)
# sort foo(bar) is interpreted as sort foo bar
# parentheses are not optional in this case
print sort(foo('bar'));
>>>>
print sort(foo('bar'));
####
# substr assignment
substr(my $a, 0, 0) = (foo(), bar());
$a++;
####
# This following line works around an unfixed bug that we are not trying to
# test for here:
# CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised
# hint hash
BEGIN { $^H{'foo'} = undef; }
{
BEGIN { $^H{'bar'} = undef; }
{
BEGIN { $^H{'baz'} = undef; }
{
print $_;
}
print $_;
}
print $_;
}
BEGIN { $^H{q[']} = '('; }
print $_;
####
# This following line works around an unfixed bug that we are not trying to
# test for here:
# CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised
# hint hash changes that serialise the same way with sort %hh
BEGIN { $^H{'a'} = 'b'; }
{
BEGIN { $^H{'b'} = 'a'; delete $^H{'a'}; }
( run in 0.639 second using v1.01-cache-2.11-cpan-39bf76dae61 )