From 57f45d7ba6658ede12e3850ae36f93319790c957 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 3 Apr 2011 22:32:16 -0700
Subject: [PATCH] =?utf8?q?[perl=20#87664]=20Don=E2=80=99t=20autovivify=20s?=
 =?utf8?q?tashes=20when=20anonymising=20CVs?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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:
---
 sv.c         |  3 ++-
 t/op/stash.t | 15 ++++++++++++++-
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/sv.c b/sv.c
index 9ea0b50..447c2bc 100644
--- 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
--- 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;
-- 
2.7.4