In B.xs, use PPCODE rather than a typemap for output of T_SV_OBJ

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 91b8b8c..da8d764 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -987,6 +987,11 @@ 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;
+       bool mpm = FALSE;
+       const char *name = NULL;
+       STRLEN namlen;
+       HV *stash = NULL;
+
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -1017,20 +1022,36 @@ 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. */
+        * 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(HeVAL(entry)) == SVt_PVGV) {
-                   HV * const stash = GvHV((GV *)HeVAL(entry));
-                   if (stash && HvENAME_get(stash))
-                       mro_package_moved(
-                        NULL, stash, (GV *)HeVAL(entry), NULL, 0
+                && 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
+                   ) {
+                       mpm = TRUE;
+                       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)
                        );
+                   }
                }
        }
 
@@ -1063,6 +1084,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            if (xhv->xhv_keys == 0)
                HvHASKFLAGS_off(hv);
        }
+
+       if (mpm) mro_package_moved(NULL, stash, NULL, name, namlen);
+
        return sv;
     }
     if (SvREADONLY(hv)) {
@@ -1457,7 +1481,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) {
@@ -1544,7 +1568,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);
     }
@@ -1828,11 +1852,11 @@ Perl_hv_undef(pTHX_ HV *hv)
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
 
-    if ((name = HvNAME_get(hv)) && !PL_dirty)
+    if ((name = HvENAME_get(hv)) && !PL_dirty)
         mro_isa_changed_in(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);
@@ -2082,6 +2106,18 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     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)
 {
@@ -2126,6 +2162,18 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len)
     }
 }
 
+/*
+=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)
 {