This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add 'head' field to PerlIOl struct
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 13968b4..a9fedb4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -735,7 +735,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        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
@@ -987,6 +987,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     entry = *oentry;
     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
        SV *sv;
+       U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
+       GV *gv = NULL;
+       HV *stash = NULL;
+
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -1017,20 +1021,28 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
             Safefree(key);
 
        /* If this is a stash and the key ends with ::, then someone is 
-          deleting a package. This must come before the entry is
-          actually detached from the hash, as mro_package_moved checks
-          whether the passed gv is still in the symbol table before
-          doing anything. */
-       if (HeVAL(entry) && HvNAME(hv)) {
+        * deleting a package.
+        */
+       if (HeVAL(entry) && HvENAME_get(hv)) {
+               gv = (GV *)HeVAL(entry);
                if (keysv) key = SvPV(keysv, klen);
                if (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':'
-                && SvTYPE(HeVAL(entry)) == SVt_PVGV) {
-                   HV * const stash = GvHV((GV *)HeVAL(entry));
-                   if (stash && HvNAME(stash))
-                       mro_package_moved(
-                        NULL, stash, (GV *)HeVAL(entry), NULL, 0
+                && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6))
+                && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv))
+                && HvENAME_get(stash)) {
+                       /* 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;
+                       /* Hang on to it for a bit. */
+                       SvREFCNT_inc_simple_void_NN(
+                        sv_2mortal((SV *)gv)
                        );
                }
+               else if (klen == 3 && strnEQ(key, "ISA", 3))
+                   mro_changes = 1;
        }
 
        if (d_flags & G_DISCARD)
@@ -1062,6 +1074,11 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            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, gv, 1);
+
        return sv;
     }
     if (SvREADONLY(hv)) {
@@ -1456,7 +1473,7 @@ 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))
+    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) {
@@ -1543,7 +1560,7 @@ Perl_hv_clear(pTHX_ HV *hv)
     HvREHASH_off(hv);
     reset:
     if (SvOOK(hv)) {
-        if(HvNAME_get(hv))
+        if(HvENAME_get(hv))
             mro_isa_changed_in(hv);
        HvEITER_set(hv, NULL);
     }
@@ -1625,28 +1642,18 @@ S_hfreeentries(pTHX_ HV *hv)
 {
     /* This is the array that we're going to restore  */
     HE **const orig_array = HvARRAY(hv);
-    HEK *name;
-    U32 name_count;
+    HE **tmp_array = NULL;
+    const bool has_aux = SvOOK(hv);
+    struct xpvhv_aux * current_aux = NULL;
     int attempts = 100;
+    
+    const bool mpm = PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv);
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
     if (!orig_array)
        return;
 
-    if (SvOOK(hv)) {
-       /* If the hash is actually a symbol table with a name, look after the
-          name.  */
-       struct xpvhv_aux *iter = HvAUX(hv);
-
-       name = iter->xhv_name;
-       name_count = iter->xhv_name_count;
-       iter->xhv_name = NULL;
-    } else {
-       name = NULL;
-       name_count = 0;
-    }
-
     /* orig_array remains unchanged throughout the loop. If after freeing all
        the entries it turns out that one of the little blighters has triggered
        an action that has caused HvARRAY to be re-allocated, then we set
@@ -1659,14 +1666,42 @@ S_hfreeentries(pTHX_ HV *hv)
        HE ** const array = HvARRAY(hv);
        I32 i = HvMAX(hv);
 
-       /* Because we have taken xhv_name out, the only allocated pointer
-          in the aux structure that might exist is the backreference array.
-       */
+       struct xpvhv_aux *iter = SvOOK(hv) ? HvAUX(hv) : NULL;
+
+       /* 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 (SvOOK(hv)) {
            HE *entry;
-            struct mro_meta *meta;
-           struct xpvhv_aux *iter = HvAUX(hv);
+
+           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_u.xhvnameu_name || iter->xhv_mro_meta) {
+               struct xpvhv_aux * const newaux = hv_auxinit(hv);
+               newaux->xhv_name_count = iter->xhv_name_count;
+               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.
+            */
+
            /* weak references: if called from sv_clear(), the backrefs
             * should already have been killed; if there are any left, its
             * because we're doing hv_clear() or hv_undef(), and the HV
@@ -1716,35 +1751,15 @@ S_hfreeentries(pTHX_ HV *hv)
            iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
            iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
 
-            if((meta = iter->xhv_mro_meta)) {
-               if (meta->mro_linear_all) {
-                   SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
-                   meta->mro_linear_all = NULL;
-                   /* This is just acting as a shortcut pointer.  */
-                   meta->mro_linear_current = NULL;
-               } else if (meta->mro_linear_current) {
-                   /* Only the current MRO is stored, so this owns the data.
-                    */
-                   SvREFCNT_dec(meta->mro_linear_current);
-                   meta->mro_linear_current = NULL;
-               }
-                if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
-                SvREFCNT_dec(meta->isa);
-                Safefree(meta);
-                iter->xhv_mro_meta = NULL;
-            }
-
            /* There are now no allocated pointers in the aux structure.  */
-
-           SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure.  */
-           /* What aux structure?  */
        }
 
-       /* 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;
-       ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+       /* If there are no keys, there is nothing left to free. */
+       if (!((XPVHV*) SvANY(hv))->xhv_keys) break;
 
+       /* Since we have removed the HvARRAY (and possibly replaced it by
+          calling hv_auxinit), set the number of keys accordingly. */
+       ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
        do {
            /* Loop down the linked list heads  */
@@ -1753,6 +1768,19 @@ S_hfreeentries(pTHX_ HV *hv)
            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);
@@ -1769,41 +1797,39 @@ S_hfreeentries(pTHX_ HV *hv)
            break;
        }
 
-       if (SvOOK(hv)) {
-           /* Someone attempted to iterate or set the hash name while we had
-              the array set to 0.  We'll catch backferences on the next time
-              round the while loop.  */
-           assert(HvARRAY(hv));
-
-           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;
-                   while(hekp-- > name) 
-                       unshare_hek_or_pvn(*hekp, 0, 0, 0);
-                   Safefree(name);
-               }
-               else unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
-           }
-       }
-
        if (--attempts == 0) {
            Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
        }
     }
        
+    /* 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)
+       tmp_array = HvARRAY(hv);
+
     HvARRAY(hv) = orig_array;
 
-    /* If the hash was actually a symbol table, put the name back.  */
-    if (name) {
-       /* We have restored the original array.  If name is non-NULL, then
-          the original array had an aux structure at the end. So this is
-          valid:  */
-       struct xpvhv_aux * const aux = HvAUX(hv);
+    if (has_aux && current_aux)
        SvFLAGS(hv) |= SVf_OOK;
-       aux->xhv_name = name;
-       aux->xhv_name_count = name_count;
+    else
+       SvFLAGS(hv) &=~SVf_OOK;
+
+    /* If the hash was actually a symbol table, put the name and MRO
+       caches back.  */
+    if (current_aux) {
+       struct xpvhv_aux * const aux
+        = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
+       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;
     }
+
+    if (tmp_array) Safefree(tmp_array);
 }
 
 /*
@@ -1815,7 +1841,7 @@ Undefines the hash.
 */
 
 void
-Perl_hv_undef(pTHX_ HV *hv)
+Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 {
     dVAR;
     register XPVHV* xhv;
@@ -1826,19 +1852,75 @@ Perl_hv_undef(pTHX_ HV *hv)
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
 
-    if ((name = HvNAME_get(hv)) && !PL_dirty)
-        mro_isa_changed_in(hv);
-
-    hfreeentries(hv);
-    if (name) {
+    /* 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);
     }
-    SvFLAGS(hv) &= ~SVf_OOK;
-    Safefree(HvARRAY(hv));
-    xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
-    HvARRAY(hv) = 0;
+    hfreeentries(hv);
+    if (SvOOK(hv)) {
+      struct xpvhv_aux * const aux = HvAUX(hv);
+      struct mro_meta *meta;
+      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, flags);
+      }
+      if((meta = aux->xhv_mro_meta)) {
+       if (meta->mro_linear_all) {
+           SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
+           meta->mro_linear_all = NULL;
+           /* This is just acting as a shortcut pointer.  */
+           meta->mro_linear_current = NULL;
+       } else if (meta->mro_linear_current) {
+           /* Only the current MRO is stored, so this owns the data.
+            */
+           SvREFCNT_dec(meta->mro_linear_current);
+           meta->mro_linear_current = NULL;
+       }
+       if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
+       SvREFCNT_dec(meta->isa);
+       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;
+    }
     HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
@@ -1899,7 +1981,7 @@ S_hv_auxinit(HV *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;
@@ -2022,6 +2104,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     dVAR;
     struct xpvhv_aux *iter;
     U32 hash;
+    HEK **spot;
 
     PERL_ARGS_ASSERT_HV_NAME_SET;
     PERL_UNUSED_ARG(flags);
@@ -2031,78 +2114,140 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
-       if (iter->xhv_name) {
+       if (iter->xhv_name_u.xhvnameu_name) {
            if(iter->xhv_name_count) {
-               HEK ** const name = (HEK **)HvAUX(hv)->xhv_name;
-               HEK **hekp = name + HvAUX(hv)->xhv_name_count;
-               while(hekp-- > 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
+                    :  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_u.xhvnameu_name;
+               iter->xhv_name_count = 0;
+             }
+             else {
+               if(iter->xhv_name_count > 0) {
+                   /* shift some things over */
+                   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 = 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 {
+               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 unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
        }
+       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_u.xhvnameu_name;
     }
     PERL_HASH(hash, name, len);
-    iter->xhv_name = name ? share_hek(name, len, hash) : NULL;
-    iter->xhv_name_count = 0;
+    *spot = name ? share_hek(name, len, hash) : NULL;
 }
 
+/*
+=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_name_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_NAME_ADD;
+    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) {
-       aux->xhv_name = share_hek(name, len, hash);
-       return;
-    }
-
     if (aux->xhv_name_count) {
-       HEK ** const xhv_name = (HEK **)aux->xhv_name;
-       HEK **hekp = xhv_name + aux->xhv_name_count;
-       U32 count = aux->xhv_name_count;
+       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 (
             HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)
-           ) return;
-       aux->xhv_name_count++;
-       Renewc(aux->xhv_name, aux->xhv_name_count, HEK *, HEK);
-       ((HEK **)aux->xhv_name)[count] = share_hek(name, len, hash);
+           ) {
+               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++;
+       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 (
-           HEK_LEN(existing_name) == (I32)len
+           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 = 2;
-       *(HEK **)aux->xhv_name = existing_name;
-       ((HEK **)aux->xhv_name)[1] = share_hek(name, len, hash);
+       Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *);
+       aux->xhv_name_count = existing_name ? 2 : -2;
+       *aux->xhv_name_u.xhvnameu_names = existing_name;
+       (aux->xhv_name_u.xhvnameu_names)[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_name_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_NAME_DELETE;
+    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);
@@ -2110,35 +2255,50 @@ Perl_hv_name_delete(pTHX_ HV *hv, const char *name, U32 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 **victim = namep + aux->xhv_name_count;
-       while (victim-- > namep)
+       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)
            if (
                HEK_LEN(*victim) == (I32)len
             && memEQ(HEK_KEY(*victim), name, len)
            ) {
                unshare_hek_or_pvn(*victim, 0, 0, 0);
-               if (!--aux->xhv_name_count) { /* none left */
+               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_u.xhvnameu_names = 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 + aux->xhv_name_count);
+                   *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)
+        HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len
+     && memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len)
     ) {
-       unshare_hek_or_pvn(aux->xhv_name, 0, 0, 0);
-       aux->xhv_name = NULL;
+       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;
     }
 }
 
@@ -3268,7 +3428,7 @@ Perl_store_cop_label(pTHX_ COP *const cop, const char *label, STRLEN len,
     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