Deparse: avoid upgrading RV to GV in stash entries

As well as being undesirable in its own right, it was causing some subs
not to be deparsed.

In something like

    package Foo;
    sub f { ... }
    *g = \&f;

The stash entry $Foo::{f} is an RV pointing to the CV, while $Foo::{g} is
a GV whose CV slot points to the same CV.

That CV's CvNAME() will be 'f' and its CvSTASH() will point to %Foo::.

If Deparse attempts to process $Foo::{g} before $Foo::{f}, it will get a
GV and in that code path it does something like

    $cv = $gv->CV;
    next if $$gv != ${$cv->GV}; # Ignore imposters

The trouble is that $cv->GV calls (at the C level) CvGV(cv), which tries
to retrieve the GV stored in $Foo::{f}, and finding only an RV, upgrades
it to a GV.

This confuses Deparse, because it has already created objects for all the
stash's entries, so when it comes to process $Foo::{f}, it already
has a B::IV object for the RV (and so goes down the RV code path), but
further introspection of that object (such as flags) sees a GV,

Hence the 3 lines of code at the top of this text were being deparsed
without 'sub f {}' being emitted.

This has been a problem for a while, but only recently has the "RV->CV
instead of GV->CV" optimisation been applied outside of package main::,
and so become more noticeable.

1 files changed, 17 insertions, 1 deletions

diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index fe176e1a62..ca1bdb4384 100644
--- 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__