From: gfx <gfuji@cpan.org>
Date: Mon, 31 Aug 2009 02:25:42 +0000 (+0900)
Subject: Allow deparsing (re)named subs
X-Git-Tag: 0.05~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FSub-Name.git;a=commitdiff_plain;h=fa213968c7910aab4fde2b0fac110d9eb7546fa5

Allow deparsing (re)named subs

Previously the pad was abused to refcount GVs. This played tricks on various
modules trying to peek into the pads of (re)named subs. Instead of messing with
the pad, we now use regular refcounted magic.

Closes RT#42725.
---

diff --git a/Changes b/Changes
index 741a0ec..4c4fc51 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+    * Stop using the padlist to refcount GVs. Instead use regular magic. This
+      allows various modules, including B::Deparse, to safely peek into pads of
+      (re)named subs (Closes RT#42725) (Goro Fuji).
     * Support perl >= 5.13.3 by using the new CvGV_set interface there
       (Closes RT#59558).
     * Stop using the deprecated PL_no_symref (Closes RT#57843).
diff --git a/Name.xs b/Name.xs
index 2c669bd..f2c7903 100644
--- a/Name.xs
+++ b/Name.xs
@@ -31,6 +31,7 @@ subname(name, sub)
 	GV *gv;
 	HV *stash = CopSTASH(PL_curcop);
 	char *s, *end = NULL, saved;
+	MAGIC *mg;
     PPCODE:
 	if (!SvROK(sub) && SvGMAGICAL(sub))
 		mg_get(sub);
@@ -65,29 +66,21 @@ subname(name, sub)
 	}
 	gv = (GV *) newSV(0);
 	gv_init(gv, stash, name, s - name, TRUE);
-#ifndef USE_5005THREADS
-	if (CvPADLIST(cv)) {
-		/* cheap way to refcount the gv */
-		av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
-	} else
-#endif
-	{
-		/* expensive way to refcount the gv */
-		MAGIC *mg = SvMAGIC(cv);
-		while (mg && mg->mg_virtual != &subname_vtbl)
-			mg = mg->mg_moremagic;
-		if (!mg) {
-			Newz(702, mg, 1, MAGIC);
-			mg->mg_moremagic = SvMAGIC(cv);
-			mg->mg_type = PERL_MAGIC_ext;
-			mg->mg_virtual = &subname_vtbl;
-			SvMAGIC_set(cv, mg);
-		}
-		if (mg->mg_flags & MGf_REFCOUNTED)
-			SvREFCNT_dec(mg->mg_obj);
-		mg->mg_flags |= MGf_REFCOUNTED;
-		mg->mg_obj = (SV *) gv;
+
+	mg = SvMAGIC(cv);
+	while (mg && mg->mg_virtual != &subname_vtbl)
+		mg = mg->mg_moremagic;
+	if (!mg) {
+		Newz(702, mg, 1, MAGIC);
+		mg->mg_moremagic = SvMAGIC(cv);
+		mg->mg_type = PERL_MAGIC_ext;
+		mg->mg_virtual = &subname_vtbl;
+		SvMAGIC_set(cv, mg);
 	}
+	if (mg->mg_flags & MGf_REFCOUNTED)
+		SvREFCNT_dec(mg->mg_obj);
+	mg->mg_flags |= MGf_REFCOUNTED;
+	mg->mg_obj = (SV *) gv;
 #ifndef CvGV_set
 	CvGV(cv) = gv;
 #else