B-DeparseTree

 view release on metacpan or  search on metacpan

t/testdata/P526.pm  view on Meta::CPAN

####
# f($a[0]);
my @a;
f($a[0]);
####
#qr/\Q$h{'key'}\E/;
my %h;
qr/\Q$h{'key'}\E/;
####
# my $x = "$h{foo}";
my %h;
my $x = "$h{'foo'}";
####
# weird constant hash key
my %h;
my $x = $h{"\000\t\x{100}"};
####
# multideref and packages
package foo;
my(%bar) = ('a', 'b');
our(@bar) = (1, 2);
$bar{'k'} = $bar[200];
$main::bar{'k'} = $main::bar[200];
$foo::bar{'k'} = $foo::bar[200];
package foo2;
$bar{'k'} = $bar[200];
$main::bar{'k'} = $main::bar[200];
$foo::bar{'k'} = $foo::bar[200];
>>>>
package foo;
my(%bar) = ('a', 'b');
our(@bar) = (1, 2);
$bar{'k'} = $bar[200];
$main::bar{'k'} = $main::bar[200];
$foo::bar{'k'} = $bar[200];
package foo2;
$bar{'k'} = $foo::bar[200];
$main::bar{'k'} = $main::bar[200];
$foo::bar{'k'} = $foo::bar[200];
####
# multideref and local
my %h;
local $h{'foo'}[0] = 1;
####
# multideref and exists
my(%h, $i);
my $e = exists $h{'foo'}[$i];
####
# multideref and delete
my(%h, $i);
my $e = delete $h{'foo'}[$i];
####
# multideref with leading expression
my $r;
my $x = +($r // [])->{'foo'}[0];
####
# multideref with complex middle index
my(%h, $i, $j, $k);
my $x = $h{'foo'}[$i + $j]{$k};
####
# multideref with trailing non-simple index that initially looks simple
# (i.e. the constant "3")
my($r, $i, $j, $k);
my $x = +($r || {})->{'foo'}[$i + $j]{3 + $k};
####
# chdir
chdir 'file';
chdir FH;
chdir;
####
# 5.22 bitops
# CONTEXT use feature "bitwise"; no warnings "experimental::bitwise";
$_ = $_ | $_;
$_ = $_ & $_;
$_ = $_ ^ $_;
$_ = ~$_;
$_ = $_ |. $_;
$_ = $_ &. $_;
$_ = $_ ^. $_;
$_ = ~.$_;
$_ |= $_;
$_ &= $_;
$_ ^= $_;
$_ |.= $_;
$_ &.= $_;
$_ ^.= $_;
####
####
# Should really use 'no warnings "experimental::signatures"',
# but it doesn't yet deparse correctly.
# anon subs used because this test framework doesn't deparse named subs
# in the DATA code snippets.
#
# general signature
no warnings;
use feature 'signatures';
my $x;
sub ($a, $, $b = $glo::bal, $c = $a, $d = 'foo', $e = -37, $f = 0, $g = 1, $h = undef, $i = $a + 1, $j = /foo/, @) {
    $x++;
}
;
$x++;
####
# Signature and prototype
no warnings;
use feature 'signatures';
my $x;
sub ($a, $b) : prototype($$) {
    $x++;
}
;
$x++;
####
# Signature and prototype and attrs
no warnings;
use feature 'signatures';
my $x;
sub ($a, $b) : prototype($$) lvalue {
    $x++;
}
;



( run in 0.650 second using v1.01-cache-2.11-cpan-39bf76dae61 )