This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update pods
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index ab22584..cabaac7 100644 (file)
--- 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,7 +1470,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return;
     val = HeVAL(entry);
-    if (HvNAME(hv) && anonymise_cv(HvNAME(hv), val) && GvCVu(val))
+    if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val))
        mro_method_changed_in(hv);
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1483,7 +1485,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 }
 
 static I32
-S_anonymise_cv(const char *stash, SV *val)
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
 {
     CV *cv;
 
@@ -1491,12 +1493,17 @@ S_anonymise_cv(const char *stash, SV *val)
 
     if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
        if ((SV *)CvGV(cv) == val) {
-           SV *gvname;
            GV *anongv;
 
-           gvname = newSVpvf("%s::__ANON__", stash ? stash : "__ANON__");
-           anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
-           SvREFCNT_dec(gvname);
+           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;
@@ -2142,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 */
@@ -2429,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);
 }