[perl #87664] Don’t autovivify stashes when anonymising CVs

This commit stops CV anonymisation from autovivifying stashes to point
to (unless the stash is %__ANON__::).

If a stash has been deleted from its original position in the symbol
table, then its HvNAME will no longer indicate where to find it.

S_anonymise_cv_maybe in sv.c was using the HvNAME to look up (and
autovivify) the *__ANON__ glob in the stash, without taking into
account that it might not actually be looking in the right spot.

So now, after checking that the stash still has a name (HvNAME), it
uses the HvENAME to find it. If the HvENAME is null, which indicates
that the stash has been detached altogether, then %__ANON__:: is used,
as happens when HvNAME is null.

This solves a Class::Monadic failure introduced by commit 2d0d1eccfc
([perl #79208] %stash:: = () anonymises CVs), which was included
in 5.13.7.

Basically, it can be reduced to this:

diff --git a/sv.c b/sv.c
index 9ea0b50..447c2bc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5991,7 +5991,8 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
     }
 
     /* if not, anonymise: */
-    stash  = GvSTASH(gv) ? HvNAME(GvSTASH(gv)) : NULL;
+    stash  = GvSTASH(gv) && HvNAME(GvSTASH(gv))
+              ? HvENAME(GvSTASH(gv)) : NULL;
     gvname = Perl_newSVpvf(aTHX_ "%s::__ANON__",
                                        stash ? stash : "__ANON__");
     anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);

diff --git a/t/op/stash.t b/t/op/stash.t
index 3fdda1f..de1297d 100644 (file)
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan( tests => 51 );
+plan( tests => 53 );
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
@@ -136,6 +136,19 @@ SKIP: {
        is($st, q/__ANON__/, "...and an __ANON__ stash");
     }
 
+    my $sub = do {
+       package six;
+       \&{"six"}
+    };
+    my $stash_glob = delete $::{"six::"};
+    # Now free the GV while the stash still exists (though detached)
+    delete $$stash_glob{"six"};
+    $gv = B::svref_2object($sub)->GV;
+    ok($gv->isa(q/B::GV/),
+       'anonymised CV whose stash is detached still has a GV');
+    is $gv->STASH->NAME, '__ANON__',
+     'CV anonymised when its stash is detached becomes __ANON__::__ANON__';
+
     # CvSTASH should be null on a named sub if the stash has been deleted
     {
        package FOO;