-Do now also reports updates and use of PL_stashcache.

diff --git a/gv.c b/gv.c
index 12f9491..f352452 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2172,6 +2172,7 @@ Perl_gp_free(pTHX_ GV *gv)
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
         const HEK *hvname_hek = HvNAME_HEK(hv);
+        DEBUG_o(Perl_deb(aTHX_ "gp_free clearing PL_stashcache for '%"HEKf"'\n", hvname_hek));
         if (PL_stashcache && hvname_hek)
            (void)hv_delete(PL_stashcache, HEK_KEY(hvname_hek),
                       (HEK_UTF8(hvname_hek) ? -HEK_LEN(hvname_hek) : HEK_LEN(hvname_hek)),

diff --git a/hv.c b/hv.c
index d542462..5432280 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1812,11 +1812,14 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
     /* note that the code following prior to hfreeentries is duplicated
      * in sv_clear(), and changes here should be done there too */
     if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
-        if (PL_stashcache)
+        if (PL_stashcache) {
+            DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
+                             HEKf"'\n", HvNAME_HEK(hv)));
            (void)hv_delete(PL_stashcache, name,
                             HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv),
                             G_DISCARD
                            );
+        }
        hv_name_set(hv, NULL, 0, 0);
     }
     if (save) {
@@ -1831,20 +1834,26 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
       if ((name = HvENAME_get(hv))) {
        if (PL_phase != PERL_PHASE_DESTRUCT)
            mro_isa_changed_in(hv);
-        if (PL_stashcache)
+        if (PL_stashcache) {
+            DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%"
+                             HEKf"'\n", HvENAME_HEK(hv)));
            (void)hv_delete(
                    PL_stashcache, name,
                     HEK_UTF8(HvENAME_HEK(hv)) ? -HvENAMELEN_get(hv) : 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)
+        if (name && PL_stashcache) {
+            DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%"
+                             HEKf"'\n", HvNAME_HEK(hv)));
            (void)hv_delete(PL_stashcache, name, (HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv)), G_DISCARD);
+        }
        hv_name_set(hv, NULL, 0, flags);
       }
       if((meta = aux->xhv_mro_meta)) {

diff --git a/mro.c b/mro.c
index c30662d..8ed73f6 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -952,9 +952,13 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
            while (items--) {
                 const U32 name_utf8 = SvUTF8(*svp);
                STRLEN len;
-               const char *name = SvPVx_const(*svp++, len);
-               if(PL_stashcache)
+               const char *name = SvPVx_const(*svp, len);
+               if(PL_stashcache) {
+                    DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%"SVf"'\n",
+                                     *svp));
                   (void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD);
+                }
+                ++svp;
                hv_ename_delete(oldstash, name, len, name_utf8);
 
                if (!fetched_isarev) {

diff --git a/pp_hot.c b/pp_hot.c
index 302f47e..d40e8c5 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2980,6 +2980,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
          
         if (he) { 
             stash = INT2PTR(HV*,SvIV(HeVAL(he)));
+            DEBUG_o(Perl_deb(aTHX_ "PL_stashcache hit %p for '%"SVf"'\n",
+                             stash, sv));
             goto fetch;
         }
 
@@ -3003,6 +3005,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                SV* const ref = newSViv(PTR2IV(stash));
                (void)hv_store(PL_stashcache, packname,
                                 packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0);
+                DEBUG_o(Perl_deb(aTHX_ "PL_stashcache caching %p for '%"SVf"'\n",
+                                 stash, sv));
            }
            goto fetch;
        }

diff --git a/sv.c b/sv.c
index f63ab8d..bd8afb7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1397,6 +1397,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
            SvOBJECT_on(io);
            /* Clear the stashcache because a new IO could overrule a package
               name */
+            DEBUG_o(Perl_deb(aTHX_ "sv_upgrade clearing PL_stashcache\n"));
            hv_clear(PL_stashcache);
 
            SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
@@ -6047,9 +6048,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                if (   PL_phase != PERL_PHASE_DESTRUCT
                    && (name = HvNAME((HV*)sv)))
                {
-                   if (PL_stashcache)
+                   if (PL_stashcache) {
+                    DEBUG_o(Perl_deb(aTHX_ "sv_clear clearing PL_stashcache for '%"SVf"'\n",
+                                     sv));
                        (void)hv_delete(PL_stashcache, name,
                            HvNAMEUTF8((HV*)sv) ? -HvNAMELEN_get((HV*)sv) : HvNAMELEN_get((HV*)sv), G_DISCARD);
+                    }
                    hv_name_set((HV*)sv, NULL, 0, 0);
                }