return NULL;
}
if (action & HV_FETCH_LVALUE) {
- val = newSV(0);
+ val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0);
if (SvMAGICAL(hv)) {
/* At this point the old hv_fetch code would call to hv_store,
which in turn might do some tied magic. So we need to make that
entry = *oentry;
for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
SV *sv;
+ U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
+ const char *name = NULL;
+ STRLEN namlen;
+ HV *stash = NULL;
+
if (HeHASH(entry) != hash) /* strings can't be equal */
continue;
if (HeKLEN(entry) != (I32)klen)
if (k_flags & HVhek_FREEKEY)
Safefree(key);
+ /* If this is a stash and the key ends with ::, then someone is
+ * deleting a package.
+ * Check whether the gv (HeVAL(entry)) is still in the symbol
+ * table and then save the name to pass to mro_package_moved after
+ * the deletion.
+ * We cannot pass the gv to mro_package_moved directly, as that
+ * function also checks whether the gv is to be found at the loca-
+ * tion its name indicates, which will no longer be the case once
+ * this element is deleted. So we have to do that check here.
+ */
+ if (HeVAL(entry) && HvENAME_get(hv)) {
+ sv = HeVAL(entry);
+ if (keysv) key = SvPV(keysv, klen);
+ if (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':'
+ && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6))
+ && SvTYPE(sv) == SVt_PVGV && (stash = GvHV((GV *)sv))
+ && HvENAME_get(stash)) {
+ SV * const namesv = sv_newmortal();
+ gv_fullname4(namesv, (GV *)sv, NULL, 0);
+ if (
+ gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV)
+ == (GV *)sv
+ ) {
+ mro_changes = 2;
+ name = SvPV_const(namesv, namlen);
+ namlen -= 2; /* skip trailing :: */
+ /* Hang on to it for a bit. */
+ SvREFCNT_inc_simple_void_NN(
+ sv_2mortal((SV *)stash)
+ );
+ }
+ }
+ else if (klen == 3 && strnEQ(key, "ISA", 3))
+ mro_changes = 1;
+ }
+
if (d_flags & G_DISCARD)
sv = NULL;
else {
HvPLACEHOLDERS(hv)++;
} else {
*oentry = HeNEXT(entry);
-
- /* If this is a stash and the key ends with ::, then someone is
- deleting a package. */
- if (sv && HvNAME(hv)) {
- if (keysv) key = SvPV(keysv, klen);
- if (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':'
- && SvTYPE(sv) == SVt_PVGV) {
- const HV * const stash = GvHV((GV *)sv);
- if (stash && HvNAME(stash))
- mro_package_moved(NULL, stash, NULL, NULL, 0);
- }
- }
-
if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
if (xhv->xhv_keys == 0)
HvHASKFLAGS_off(hv);
}
+
+ if (mro_changes == 1) mro_isa_changed_in(hv);
+ else if (mro_changes == 2)
+ mro_package_moved(NULL, stash, NULL, name, namlen);
+
return sv;
}
if (SvREADONLY(hv)) {
if (!entry)
return;
val = HeVAL(entry);
- if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvNAME_get(hv))
+ if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv))
mro_method_changed_in(hv); /* deletion of method from stash */
SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
HvREHASH_off(hv);
reset:
if (SvOOK(hv)) {
- if(HvNAME_get(hv))
+ if(HvENAME_get(hv))
mro_isa_changed_in(hv);
HvEITER_set(hv, NULL);
}
/* This is the array that we're going to restore */
HE **const orig_array = HvARRAY(hv);
HEK *name;
- U32 name_count;
+ I32 name_count;
int attempts = 100;
PERL_ARGS_ASSERT_HFREEENTRIES;
if (HvAUX(hv)->xhv_name) {
if(HvAUX(hv)->xhv_name_count) {
HEK ** const name = (HEK **)HvAUX(hv)->xhv_name;
- HEK **hekp = name + HvAUX(hv)->xhv_name_count;
+ I32 const count = HvAUX(hv)->xhv_name_count;
+ HEK **hekp = name + (count < 0 ? -count : count);
while(hekp-- > name)
unshare_hek_or_pvn(*hekp, 0, 0, 0);
Safefree(name);
DEBUG_A(Perl_hv_assert(aTHX_ hv));
xhv = (XPVHV*)SvANY(hv);
- if ((name = HvNAME_get(hv)) && !PL_dirty)
- mro_isa_changed_in(hv);
+ if ((name = HvENAME_get(hv)) && PL_phase != PERL_PHASE_DESTRUCT)
+ {
+ /* Delete the @ISA element before calling mro_package_moved, so it
+ does not see it. */
+ (void)hv_delete(hv, "ISA", 3, G_DISCARD);
+ mro_package_moved(NULL, hv, NULL, name, HvENAMELEN_get(hv));
+ }
hfreeentries(hv);
- if (name) {
+ if (name || (name = HvNAME(hv))) {
if (PL_stashcache)
(void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
hv_name_set(hv, NULL, 0, 0);
dVAR;
struct xpvhv_aux *iter;
U32 hash;
+ HEK **spot;
PERL_ARGS_ASSERT_HV_NAME_SET;
PERL_UNUSED_ARG(flags);
iter = HvAUX(hv);
if (iter->xhv_name) {
if(iter->xhv_name_count) {
+ if(!name) {
HEK ** const name = (HEK **)HvAUX(hv)->xhv_name;
- HEK **hekp = name + HvAUX(hv)->xhv_name_count;
- while(hekp-- > name)
+ HEK **hekp = name + (
+ iter->xhv_name_count < 0
+ ? -iter->xhv_name_count
+ : iter->xhv_name_count
+ );
+ while(hekp-- > name+1)
unshare_hek_or_pvn(*hekp, 0, 0, 0);
+ /* The first elem may be null. */
+ if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
Safefree(name);
+ spot = &iter->xhv_name;
+ iter->xhv_name_count = 0;
+ }
+ else {
+ spot = (HEK **)iter->xhv_name;
+ if(iter->xhv_name_count > 0) {
+ /* shift some things over */
+ Renew(spot, iter->xhv_name_count, HEK *);
+ spot[iter->xhv_name_count++] = spot[1];
+ spot[1] = spot[0];
+ }
+ else if(*spot) {
+ unshare_hek_or_pvn(*spot, 0, 0, 0);
+ }
+ }
+ }
+ else {
+ unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
+ spot = &iter->xhv_name;
}
- else unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
}
+ else spot = &iter->xhv_name;
} else {
if (name == 0)
return;
iter = hv_auxinit(hv);
+ spot = &iter->xhv_name;
}
PERL_HASH(hash, name, len);
- iter->xhv_name = name ? share_hek(name, len, hash) : NULL;
+ *spot = name ? share_hek(name, len, hash) : NULL;
iter->xhv_name_count = 0;
}
+/*
+=for apidoc hv_ename_add
+
+Adds a name to a stash's internal list of effective names. See
+C<hv_ename_delete>.
+
+This is called when a stash is assigned to a new location in the symbol
+table.
+
+=cut
+*/
+
+void
+Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len)
+{
+ dVAR;
+ struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
+ U32 hash;
+
+ PERL_ARGS_ASSERT_HV_ENAME_ADD;
+
+ if (len > I32_MAX)
+ Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+
+ PERL_HASH(hash, name, len);
+
+ if (aux->xhv_name_count) {
+ HEK ** const xhv_name = (HEK **)aux->xhv_name;
+ I32 count = aux->xhv_name_count;
+ HEK **hekp = xhv_name + (count < 0 ? -count : count);
+ while (hekp-- > xhv_name)
+ if (
+ HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)
+ ) {
+ if (hekp == xhv_name && count < 0)
+ aux->xhv_name_count = -count;
+ return;
+ }
+ if (count < 0) aux->xhv_name_count--, count = -count;
+ else aux->xhv_name_count++;
+ Renewc(aux->xhv_name, count + 1, HEK *, HEK);
+ ((HEK **)aux->xhv_name)[count] = share_hek(name, len, hash);
+ }
+ else {
+ HEK *existing_name = aux->xhv_name;
+ if (
+ existing_name && HEK_LEN(existing_name) == (I32)len
+ && memEQ(HEK_KEY(existing_name), name, len)
+ ) return;
+ Newxc(aux->xhv_name, 2, HEK *, HEK);
+ aux->xhv_name_count = existing_name ? 2 : -2;
+ *(HEK **)aux->xhv_name = existing_name;
+ ((HEK **)aux->xhv_name)[1] = share_hek(name, len, hash);
+ }
+}
+
+/*
+=for apidoc hv_ename_delete
+
+Removes a name from a stash's internal list of effective names. If this is
+the name returned by C<HvENAME>, then another name in the list will take
+its place (C<HvENAME> will use it).
+
+This is called when a stash is deleted from the symbol table.
+
+=cut
+*/
+
+void
+Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len)
+{
+ dVAR;
+ struct xpvhv_aux *aux;
+
+ PERL_ARGS_ASSERT_HV_ENAME_DELETE;
+
+ if (len > I32_MAX)
+ Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+
+ if (!SvOOK(hv)) return;
+
+ aux = HvAUX(hv);
+ if (!aux->xhv_name) return;
+
+ if (aux->xhv_name_count) {
+ HEK ** const namep = (HEK **)aux->xhv_name;
+ I32 const count = aux->xhv_name_count;
+ HEK **victim = namep + (count < 0 ? -count : count);
+ while (victim-- > namep + 1)
+ if (
+ HEK_LEN(*victim) == (I32)len
+ && memEQ(HEK_KEY(*victim), name, len)
+ ) {
+ unshare_hek_or_pvn(*victim, 0, 0, 0);
+ if (count < 0) ++aux->xhv_name_count;
+ else --aux->xhv_name_count;
+ if (
+ (aux->xhv_name_count == 1 || aux->xhv_name_count == -1)
+ && !*namep
+ ) { /* if there are none left */
+ Safefree(namep);
+ aux->xhv_name = NULL;
+ aux->xhv_name_count = 0;
+ }
+ else {
+ /* Move the last one back to fill the empty slot. It
+ does not matter what order they are in. */
+ *victim = *(namep + (count < 0 ? -count : count) - 1);
+ }
+ return;
+ }
+ if (
+ count > 0 && HEK_LEN(*namep) == (I32)len
+ && memEQ(HEK_KEY(*namep),name,len)
+ ) {
+ aux->xhv_name_count = -count;
+ }
+ }
+ else if(
+ HEK_LEN(aux->xhv_name) == (I32)len
+ && memEQ(HEK_KEY(aux->xhv_name), name, len)
+ ) {
+ const HEK * const namehek = aux->xhv_name;
+ Newxc(aux->xhv_name, 1, HEK *, HEK);
+ *(const HEK **)aux->xhv_name = namehek;
+ aux->xhv_name_count = -1;
+ }
+}
+
AV **
Perl_hv_backreferences_p(pTHX_ HV *hv) {
struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
https://perl5.git.perl.org / perl5.git / blobdiff