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);
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);
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) {
}
static I32
-S_anonymise_cv(pTHX_ const char *stash, SV *val)
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
{
CV *cv;
if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
if ((SV *)CvGV(cv) == val) {
- SV *gvname;
GV *anongv;
- gvname = Perl_newSVpvf(aTHX_ "%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;
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 */
}
}
- 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);
}