X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9953ff723fac897df4afc6a69aaa7bfe5e8dc983..777f7c561610dee641c77666e5a4a0d9ac1d4230:/hv.c diff --git a/hv.c b/hv.c index 78a1097..cabaac7 100644 --- a/hv.c +++ b/hv.c @@ -134,11 +134,15 @@ Perl_free_tied_hv_pool(pTHX) HEK * Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) { - HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); + HEK *shared; PERL_ARGS_ASSERT_HEK_DUP; PERL_UNUSED_ARG(param); + if (!source) + return NULL; + + shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); if (shared) { /* We already shared this hash key. */ (void)share_hek_hek(shared); @@ -388,8 +392,12 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); key = SvPV_const(keysv, klen); - flags = 0; is_utf8 = (SvUTF8(keysv) != 0); + if (SvIsCOW_shared_hash(keysv)) { + flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); + } else { + flags = 0; + } } else { is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); } @@ -595,7 +603,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - if (is_utf8) { + if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) { char * const keysave = (char *)key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) @@ -606,6 +614,11 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(keysave); flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + /* If the caller calculated a hash, it was on the sequence of + octets that are the UTF-8 form. We've now changed the sequence + of octets stored to that of the equivalent byte representation, + so the hash we need is different. */ + hash = 0; } } @@ -1366,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); @@ -1398,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); @@ -1430,8 +1445,10 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { SV *const sv = newSVsv(HeVAL(entry)); + SV *heksv = newSVhek(HeKEY_hek(entry)); sv_magic(sv, NULL, PERL_MAGIC_hintselem, - (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY); + (char *)heksv, HEf_SVKEY); + SvREFCNT_dec(heksv); (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), sv, HeHASH(entry), HeKFLAGS(entry)); } @@ -1453,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)); @@ -1467,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) { @@ -1631,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. */ @@ -2088,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 */ @@ -2128,26 +2188,31 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) } } } - while (!entry) { - /* OK. Come to the end of the current list. Grab the next one. */ - iter->xhv_riter++; /* HvRITER(hv)++ */ - if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { - /* There is no next one. End of the hash. */ - iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ - break; - } - entry = (HvARRAY(hv))[iter->xhv_riter]; + /* Skip the entire loop if the hash is empty. */ + if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS) + ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) { + while (!entry) { + /* OK. Come to the end of the current list. Grab the next one. */ - if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { - /* If we have an entry, but it's a placeholder, don't count it. - Try the next. */ - while (entry && HeVAL(entry) == &PL_sv_placeholder) - entry = HeNEXT(entry); + iter->xhv_riter++; /* HvRITER(hv)++ */ + if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { + /* There is no next one. End of the hash. */ + iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ + break; + } + entry = (HvARRAY(hv))[iter->xhv_riter]; + + if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { + /* If we have an entry, but it's a placeholder, don't count it. + Try the next. */ + while (entry && HeVAL(entry) == &PL_sv_placeholder) + entry = HeNEXT(entry); + } + /* Will loop again if this linked list starts NULL + (for HV_ITERNEXT_WANTPLACEHOLDERS) + or if we run through it and find only placeholders. */ } - /* Will loop again if this linked list starts NULL - (for HV_ITERNEXT_WANTPLACEHOLDERS) - or if we run through it and find only placeholders. */ } if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ @@ -2311,13 +2376,10 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) shared hek */ assert (he->shared_he_he.hent_hek == hek); - LOCK_STRTAB_MUTEX; if (he->shared_he_he.he_valu.hent_refcount - 1) { --he->shared_he_he.he_valu.hent_refcount; - UNLOCK_STRTAB_MUTEX; return; } - UNLOCK_STRTAB_MUTEX; hash = HEK_HASH(hek); } else if (len < 0) { @@ -2339,7 +2401,6 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } */ xhv = (XPVHV*)SvANY(PL_strtab); /* assert(xhv_array != 0) */ - LOCK_STRTAB_MUTEX; first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)]; if (he) { const HE *const he_he = &(he->shared_he_he); @@ -2374,13 +2435,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } } - UNLOCK_STRTAB_MUTEX; - 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); } @@ -2439,7 +2499,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) */ /* assert(xhv_array != 0) */ - LOCK_STRTAB_MUTEX; entry = (HvARRAY(PL_strtab))[hindex]; for (;entry; entry = HeNEXT(entry)) { if (HeHASH(entry) != hash) /* strings can't be equal */ @@ -2497,7 +2556,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) } ++entry->he_valu.hent_refcount; - UNLOCK_STRTAB_MUTEX; if (flags & HVhek_FREEKEY) Safefree(str);