X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=cabaac75cf1f369b80fc944ce829b780d8171831;hb=ecb374736fc633d7a24b560c2afe20a3a3d9f069;hp=ebb10fbd345f1801694526bf7c1f9dc2b1f103b7;hpb=9eb4ebd1619c036262f136e58c5c5417c17be57c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index ebb10fb..cabaac7 100644
--- a/hv.c
+++ b/hv.c
@@ -1379,8 +1379,9 @@ Perl_newHVhv(pTHX_ HV *ohv)
 		const STRLEN len = HeKLEN(oent);
 		const int flags  = HeKFLAGS(oent);
 		HE * const ent   = new_HE();
+		SV *const val    = HeVAL(oent);
 
-		HeVAL(ent)     = newSVsv(HeVAL(oent));
+		HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val);
 		HeKEY_hek(ent)
                     = shared ? share_hek_flags(key, len, hash, flags)
                              :  save_hek_flags(key, len, hash, flags);
@@ -1411,9 +1412,10 @@ Perl_newHVhv(pTHX_ HV *ohv)
 
 	hv_iterinit(ohv);
 	while ((entry = hv_iternext_flags(ohv, 0))) {
+	    SV *const val = HeVAL(entry);
 	    (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
-			         newSVsv(HeVAL(entry)), HeHASH(entry),
-			         HeKFLAGS(entry));
+			         SvIMMORTAL(val) ? val : newSVsv(val),
+				 HeHASH(entry), HeKFLAGS(entry));
 	}
 	HvRITER_set(ohv, riter);
 	HvEITER_set(ohv, eiter);
@@ -1468,8 +1470,8 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
 	return;
     val = HeVAL(entry);
-    if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvNAME_get(hv))
-        mro_method_changed_in(hv);	/* deletion of method from stash */
+    if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val))
+	mro_method_changed_in(hv);
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
 	SvREFCNT_dec(HeKEY_sv(entry));
@@ -1482,6 +1484,34 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     del_HE(entry);
 }
 
+static I32
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
+{
+    CV *cv;
+
+    PERL_ARGS_ASSERT_ANONYMISE_CV;
+
+    if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
+	if ((SV *)CvGV(cv) == val) {
+	    GV *anongv;
+
+	    if (stash) {
+		SV *gvname = newSVhek(stash);
+		sv_catpvs(gvname, "::__ANON__");
+		anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
+		SvREFCNT_dec(gvname);
+	    } else {
+		anongv = gv_fetchpvs("__ANON__::__ANON__", GV_ADDMULTI,
+				     SVt_PVCV);
+	    }
+	    CvGV(cv) = anongv;
+	    CvANON_on(cv);
+	    return 1;
+	}
+    }
+    return 0;
+}
+
 void
 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
@@ -1646,6 +1676,22 @@ S_hfreeentries(pTHX_ HV *hv)
     if (!orig_array)
 	return;
 
+    if (HvNAME(hv) && orig_array != NULL) {
+	/* symbol table: make all the contained subs ANON */
+	STRLEN i;
+	XPVHV *xhv = (XPVHV*)SvANY(hv);
+
+	for (i = 0; i <= xhv->xhv_max; i++) {
+	    HE *entry = (HvARRAY(hv))[i];
+	    for (; entry; entry = HeNEXT(entry)) {
+		SV *val = HeVAL(entry);
+		/* we need to put the subs in the __ANON__ symtable, as
+		 * this one is being cleared. */
+		anonymise_cv(NULL, val);
+	    }
+	}
+    }
+
     if (SvOOK(hv)) {
 	/* If the hash is actually a symbol table with a name, look after the
 	   name.  */
@@ -2103,8 +2149,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
                 HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
                 return entry;               /* beware, hent_val is not set */
             }
-            if (HeVAL(entry))
-                SvREFCNT_dec(HeVAL(entry));
+            SvREFCNT_dec(HeVAL(entry));
             Safefree(HeKEY_hek(entry));
             del_HE(entry);
             iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
@@ -2390,12 +2435,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
         }
     }
 
-    if (!entry && ckWARN_d(WARN_INTERNAL))
-	Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free non-existent shared string '%s'%s"
-                    pTHX__FORMAT,
-                    hek ? HEK_KEY(hek) : str,
-                    ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
+    if (!entry)
+	Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+			 "Attempt to free non-existent shared string '%s'%s"
+			 pTHX__FORMAT,
+			 hek ? HEK_KEY(hek) : str,
+			 ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
     if (k_flags & HVhek_FREEKEY)
 	Safefree(str);
 }