for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
SV *sv;
U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
- const char *name = NULL;
- STRLEN namlen;
+ GV *gv = NULL;
HV *stash = NULL;
if (HeHASH(entry) != hash) /* strings can't be equal */
/* 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);
+ gv = (GV *)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))
+ && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv))
&& 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
- ) {
+ /* A previous version of this code checked that the
+ * GV was still in the symbol table by fetching the
+ * GV with its name. That is not necessary (and
+ * sometimes incorrect), as HvENAME cannot be set
+ * on hv if it is not in the symtab. */
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)
+ sv_2mortal((SV *)gv)
);
- }
}
else if (klen == 3 && strnEQ(key, "ISA", 3))
mro_changes = 1;
if (mro_changes == 1) mro_isa_changed_in(hv);
else if (mro_changes == 2)
- mro_package_moved(NULL, stash, NULL, name, namlen);
+ mro_package_moved(NULL, stash, gv, 1);
return sv;
}
/* This is the array that we're going to restore */
HE **const orig_array = HvARRAY(hv);
HE **tmp_array = NULL;
- const bool has_aux = SvOOK(hv);
+ const bool has_aux = (SvOOK(hv) == SVf_OOK);
struct xpvhv_aux * current_aux = NULL;
int attempts = 100;
+
+ const bool mpm = PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv);
PERL_ARGS_ASSERT_HFREEENTRIES;
struct xpvhv_aux *iter = SvOOK(hv) ? HvAUX(hv) : NULL;
+ /* If there are no keys, we only need to free items in the aux
+ structure and then exit the loop. */
+ const bool empty = !((XPVHV*) SvANY(hv))->xhv_keys;
+
/* make everyone else think the array is empty, so that the destructors
* called for freed entries can't recursively mess with us */
- HvARRAY(hv) = NULL;
+ if (!empty) HvARRAY(hv) = NULL;
if (SvOOK(hv)) {
HE *entry;
- SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
- /* What aux structure? */
- /* (But we still have a pointer to it in iter.) */
+ if (!empty) {
+ SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */
+ /* What aux structure? */
+ /* (But we still have a pointer to it in iter.) */
- /* Copy the name and MRO stuff to a new aux structure
- if present. */
- if (iter->xhv_name || iter->xhv_mro_meta) {
+ /* Copy the name and MRO stuff to a new aux structure
+ if present. */
+ if (iter->xhv_name_u.xhvnameu_name || iter->xhv_mro_meta) {
struct xpvhv_aux * const newaux = hv_auxinit(hv);
- newaux->xhv_name = iter->xhv_name;
newaux->xhv_name_count = iter->xhv_name_count;
- iter->xhv_name = NULL;
+ if (newaux->xhv_name_count)
+ newaux->xhv_name_u.xhvnameu_names
+ = iter->xhv_name_u.xhvnameu_names;
+ else
+ newaux->xhv_name_u.xhvnameu_name
+ = iter->xhv_name_u.xhvnameu_name;
+
+ iter->xhv_name_u.xhvnameu_name = NULL;
newaux->xhv_mro_meta = iter->xhv_mro_meta;
iter->xhv_mro_meta = NULL;
- }
+ }
- /* Because we have taken xhv_name and
- xhv_mro_meta out, the only allocated
- pointers in the aux structure that might exist are the back-
- reference array and xhv_eiter.
- */
+ /* Because we have taken xhv_name and xhv_mro_meta out, the
+ only allocated pointers in the aux structure that might
+ exist are the back-reference array and xhv_eiter.
+ */
+ }
/* weak references: if called from sv_clear(), the backrefs
* should already have been killed; if there are any left, its
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
- /* There are now no allocated pointers in the aux structure. */
+ /* There are now no allocated pointers in the aux structure
+ unless the hash is empty. */
}
/* If there are no keys, there is nothing left to free. */
- if (!((XPVHV*) SvANY(hv))->xhv_keys) break;
+ if (empty) break;
/* Since we have removed the HvARRAY (and possibly replaced it by
calling hv_auxinit), set the number of keys accordingly. */
while (entry) {
register HE * const oentry = entry;
entry = HeNEXT(entry);
+ if (
+ mpm && HeVAL(oentry) && isGV(HeVAL(oentry)) &&
+ GvHV(HeVAL(oentry)) && HvENAME(GvHV(HeVAL(oentry)))
+ ) {
+ STRLEN klen;
+ const char * const key = HePV(oentry,klen);
+ if (klen > 1 && key[klen-1]==':' && key[klen-2]==':') {
+ mro_package_moved(
+ NULL, GvHV(HeVAL(oentry)),
+ (GV *)HeVAL(oentry), 0
+ );
+ }
+ }
hv_free_ent(hv, oentry);
}
} while (--i >= 0);
Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
}
}
+
+ /* If the array was not replaced, the rest does not apply. */
+ if (HvARRAY(hv) == orig_array) return;
/* Set aside the current array for now, in case we still need it. */
if (SvOOK(hv)) current_aux = HvAUX(hv);
- if (HvARRAY(hv) && HvARRAY(hv) != orig_array)
+ if (HvARRAY(hv))
tmp_array = HvARRAY(hv);
HvARRAY(hv) = orig_array;
- if (has_aux)
+ if (has_aux && current_aux)
SvFLAGS(hv) |= SVf_OOK;
else
SvFLAGS(hv) &=~SVf_OOK;
if (current_aux) {
struct xpvhv_aux * const aux
= SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
- aux->xhv_name = current_aux->xhv_name;
aux->xhv_name_count = current_aux->xhv_name_count;
+ if(aux->xhv_name_count)
+ aux->xhv_name_u.xhvnameu_names
+ = current_aux->xhv_name_u.xhvnameu_names;
+ else
+ aux->xhv_name_u.xhvnameu_name
+ = current_aux->xhv_name_u.xhvnameu_name;
aux->xhv_mro_meta = current_aux->xhv_mro_meta;
}
*/
void
-Perl_hv_undef(pTHX_ HV *hv)
+Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
{
dVAR;
register XPVHV* xhv;
DEBUG_A(Perl_hv_assert(aTHX_ hv));
xhv = (XPVHV*)SvANY(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));
- }
-
- if (name || (name = HvNAME(hv))) {
+ /* The name must be deleted before the call to hfreeeeentries so that
+ CVs are anonymised properly. But the effective name must be pre-
+ served until after that call (and only deleted afterwards if the
+ call originated from sv_clear). For stashes with one name that is
+ both the canonical name and the effective name, hv_name_set has to
+ allocate an array for storing the effective name. We can skip that
+ during global destruction, as it does not matter where the CVs point
+ if they will be freed anyway. */
+ if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
if (PL_stashcache)
(void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
hv_name_set(hv, NULL, 0, 0);
if (SvOOK(hv)) {
struct xpvhv_aux * const aux = HvAUX(hv);
struct mro_meta *meta;
- if (aux->xhv_name) {
- if (PL_stashcache && (name = HvNAME(hv)))
+ bool zeroed = FALSE;
+
+ if ((name = HvENAME_get(hv))) {
+ if (PL_phase != PERL_PHASE_DESTRUCT) {
+ /* This must come at this point in case
+ mro_isa_changed_in dies. */
+ Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
+ zeroed = TRUE;
+
+ mro_isa_changed_in(hv);
+ }
+ if (PL_stashcache)
+ (void)hv_delete(
+ PL_stashcache, name, HvENAMELEN_get(hv), G_DISCARD
+ );
+ }
+
+ /* If this call originated from sv_clear, then we must check for
+ * effective names that need freeing, as well as the usual name. */
+ name = HvNAME(hv);
+ if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) {
+ if (name && PL_stashcache)
(void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
- hv_name_set(hv, NULL, 0, 0);
+ hv_name_set(hv, NULL, 0, flags);
}
if((meta = aux->xhv_mro_meta)) {
if (meta->mro_linear_all) {
Safefree(meta);
aux->xhv_mro_meta = NULL;
}
+ if (!aux->xhv_name_u.xhvnameu_name)
+ SvFLAGS(hv) &= ~SVf_OOK;
+ else if (!zeroed)
+ Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
+ }
+ if (!SvOOK(hv)) {
+ Safefree(HvARRAY(hv));
+ xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
+ HvARRAY(hv) = 0;
}
- SvFLAGS(hv) &= ~SVf_OOK;
- Safefree(HvARRAY(hv));
- xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
- HvARRAY(hv) = 0;
HvPLACEHOLDERS_set(hv, 0);
if (SvRMAGICAL(hv))
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
- iter->xhv_name = 0;
+ iter->xhv_name_u.xhvnameu_name = 0;
iter->xhv_name_count = 0;
iter->xhv_backreferences = 0;
iter->xhv_mro_meta = NULL;
if (SvOOK(hv)) {
iter = HvAUX(hv);
- if (iter->xhv_name) {
+ if (iter->xhv_name_u.xhvnameu_name) {
if(iter->xhv_name_count) {
- if(!name) {
- HEK ** const name = (HEK **)HvAUX(hv)->xhv_name;
+ if(flags & HV_NAME_SETALL) {
+ HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
HEK **hekp = name + (
iter->xhv_name_count < 0
? -iter->xhv_name_count
/* The first elem may be null. */
if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
Safefree(name);
- spot = &iter->xhv_name;
+ spot = &iter->xhv_name_u.xhvnameu_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];
+ Renew(
+ iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK *
+ );
+ spot = iter->xhv_name_u.xhvnameu_names;
+ spot[iter->xhv_name_count] = spot[1];
spot[1] = spot[0];
+ iter->xhv_name_count = -(iter->xhv_name_count + 1);
}
- else if(*spot) {
+ else if(*(spot = iter->xhv_name_u.xhvnameu_names)) {
unshare_hek_or_pvn(*spot, 0, 0, 0);
}
}
}
+ else if (flags & HV_NAME_SETALL) {
+ unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0);
+ spot = &iter->xhv_name_u.xhvnameu_name;
+ }
else {
- unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
- spot = &iter->xhv_name;
+ HEK * const existing_name = iter->xhv_name_u.xhvnameu_name;
+ Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *);
+ iter->xhv_name_count = -2;
+ spot = iter->xhv_name_u.xhvnameu_names;
+ spot[1] = existing_name;
}
}
- else spot = &iter->xhv_name;
+ else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; }
} else {
if (name == 0)
return;
iter = hv_auxinit(hv);
- spot = &iter->xhv_name;
+ spot = &iter->xhv_name_u.xhvnameu_name;
}
PERL_HASH(hash, name, len);
*spot = name ? share_hek(name, len, hash) : NULL;
- iter->xhv_name_count = 0;
}
/*
*/
void
-Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len)
+Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
dVAR;
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
U32 hash;
PERL_ARGS_ASSERT_HV_ENAME_ADD;
+ PERL_UNUSED_ARG(flags);
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;
+ HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names;
I32 count = aux->xhv_name_count;
HEK **hekp = xhv_name + (count < 0 ? -count : count);
while (hekp-- > xhv_name)
}
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);
+ Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *);
+ (aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, len, hash);
}
else {
- HEK *existing_name = aux->xhv_name;
+ HEK *existing_name = aux->xhv_name_u.xhvnameu_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);
+ Newx(aux->xhv_name_u.xhvnameu_names, 2, 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);
+ *aux->xhv_name_u.xhvnameu_names = existing_name;
+ (aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, len, hash);
}
}
*/
void
-Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len)
+Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
dVAR;
struct xpvhv_aux *aux;
PERL_ARGS_ASSERT_HV_ENAME_DELETE;
+ PERL_UNUSED_ARG(flags);
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_u.xhvnameu_name) return;
if (aux->xhv_name_count) {
- HEK ** const namep = (HEK **)aux->xhv_name;
+ HEK ** const namep = aux->xhv_name_u.xhvnameu_names;
I32 const count = aux->xhv_name_count;
HEK **victim = namep + (count < 0 ? -count : count);
while (victim-- > namep + 1)
&& !*namep
) { /* if there are none left */
Safefree(namep);
- aux->xhv_name = NULL;
+ aux->xhv_name_u.xhvnameu_names = NULL;
aux->xhv_name_count = 0;
}
else {
}
}
else if(
- HEK_LEN(aux->xhv_name) == (I32)len
- && memEQ(HEK_KEY(aux->xhv_name), name, len)
+ HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len
+ && memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len)
) {
- const HEK * const namehek = aux->xhv_name;
- Newxc(aux->xhv_name, 1, HEK *, HEK);
- *(const HEK **)aux->xhv_name = namehek;
+ HEK * const namehek = aux->xhv_name_u.xhvnameu_name;
+ Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *);
+ *aux->xhv_name_u.xhvnameu_names = namehek;
aux->xhv_name_count = -1;
}
}
if (flags & ~(SVf_UTF8))
Perl_croak(aTHX_ "panic: store_cop_label illegal flag bits 0x%" UVxf,
(UV)flags);
- labelsv = sv_2mortal(newSVpvn(label, len));
+ labelsv = newSVpvn_flags(label, len, SVs_TEMP);
if (flags & SVf_UTF8)
SvUTF8_on(labelsv);
cop->cop_hints_hash
https://perl5.git.perl.org / perl5.git / blobdiff