Deparse: avoid upgrading RV to GV in stash entries

[perl5.git] / lib / B / Deparse.t

diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 27d1b3a..ca1bdb4 100644 (file)
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -13,7 +13,7 @@ BEGIN {
 use warnings;
 use strict;
 
-my $tests = 49; # not counting those in the __DATA__ section
+my $tests = 52; # not counting those in the __DATA__ section
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -546,6 +546,22 @@ unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ],
        qr'Use of uninitialized value',
       'no warnings for undefined sub';
 
+is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
+    prog => 'sub f { 1; } BEGIN { *g = \&f; }'),
+    "sub f {\n    1;\n}\nsub BEGIN {\n    *g = \\&f;\n}\n",
+    "sub glob alias shouldn't impede emitting original sub";
+
+is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
+    prog => 'package Foo; sub f { 1; } BEGIN { *g = \&f; }'),
+    "package Foo;\nsub f {\n    1;\n}\nsub BEGIN {\n    *g = \\&f;\n}\n",
+    "sub glob alias outside main shouldn't impede emitting original sub";
+
+is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
+    prog => 'package Foo; sub f { 1; } BEGIN { *Bar::f = \&f; }'),
+    "package Foo;\nsub f {\n    1;\n}\nsub BEGIN {\n    *Bar::f = \\&f;\n}\n",
+    "sub glob alias in separate package shouldn't impede emitting original sub";
+
+
 done_testing($tests);
 
 __DATA__
@@ -2864,6 +2880,7 @@ print %CORE::foo, %CORE::foo::bar;
 print $CORE::foo{'a'}, $CORE::foo::bar{'a'};
 print &CORE::foo, &CORE::foo::bar;
 print &CORE::foo(), &CORE::foo::bar();
+print \&CORE::foo, \&CORE::foo::bar;
 print *CORE::foo, *CORE::foo::bar;
 print stat CORE::foo::, stat CORE::foo::bar;
 print CORE::foo:: 1;
@@ -2878,6 +2895,7 @@ print %foo, %foo::, %foo::::;
 print $foo{'a'}, $foo::{'a'}, $foo::::{'a'};
 print &foo, &foo::, &foo::::;
 print &foo(), &foo::(), &foo::::();
+print \&foo, \&foo::, \&foo::::;
 print *foo, *foo::, *foo::::;
 print stat Foo, stat Foo::::;
 print Foo 1;
@@ -2891,6 +2909,7 @@ print %CORE, %CORE::, %CORE::::;
 print $CORE{'a'}, $CORE::{'a'}, $CORE::::{'a'};
 print &CORE, &CORE::, &CORE::::;
 print &CORE(), &CORE::(), &CORE::::();
+print \&CORE, \&CORE::, \&CORE::::;
 print *CORE, *CORE::, *CORE::::;
 print stat CORE, stat CORE::::;
 print CORE 1;
@@ -2901,7 +2920,66 @@ print %CORE::foo, %CORE::foo::, %CORE::foo::::;
 print $CORE::foo{'a'}, $CORE::foo::{'a'}, $CORE::foo::::{'a'};
 print &CORE::foo, &CORE::foo::, &CORE::foo::::;
 print &CORE::foo(), &CORE::foo::(), &CORE::foo::::();
+print \&CORE::foo, \&CORE::foo::, \&CORE::foo::::;
 print *CORE::foo, *CORE::foo::, *CORE::foo::::;
 print stat CORE::foo::, stat CORE::foo::::;
 print CORE::foo:: 1;
 print CORE::foo:::: 2;
+####
+# \&foo
+my sub foo {
+    1;
+}
+no strict 'vars';
+print \&main::foo;
+print \&{foo};
+print \&bar;
+use strict 'vars';
+print \&main::foo;
+print \&{foo};
+print \&main::bar;
+####
+# exists(&foo)
+my sub foo {
+    1;
+}
+no strict 'vars';
+print exists &main::foo;
+print exists &{foo};
+print exists &bar;
+use strict 'vars';
+print exists &main::foo;
+print exists &{foo};
+print exists &main::bar;
+# precedence of optimised-away 'keys' (OPpPADHV_ISKEYS/OPpRV2HV_ISKEYS)
+my($r1, %h1, $res);
+our($r2, %h2);
+$res = keys %h1;
+$res = keys %h2;
+$res = keys %$r1;
+$res = keys %$r2;
+$res = keys(%h1) / 2 - 1;
+$res = keys(%h2) / 2 - 1;
+$res = keys(%$r1) / 2 - 1;
+$res = keys(%$r2) / 2 - 1;
+####
+# ditto in presence of sub keys {}
+# CONTEXT sub keys {}
+no warnings;
+my($r1, %h1, $res);
+our($r2, %h2);
+CORE::keys %h1;
+CORE::keys(%h1) / 2;
+$res = CORE::keys %h1;
+$res = CORE::keys %h2;
+$res = CORE::keys %$r1;
+$res = CORE::keys %$r2;
+$res = CORE::keys(%h1) / 2 - 1;
+$res = CORE::keys(%h2) / 2 - 1;
+$res = CORE::keys(%$r1) / 2 - 1;
+$res = CORE::keys(%$r2) / 2 - 1;
+####
+# concat: STACKED: ambiguity between .= and optimised nested
+my($a, $b);
+$b = $a . $a . $a;
+(($a .= $a) .= $a) .= $a;