-Do now also reports updates and use of PL_stashcache.

5 files changed, 28 insertions, 6 deletions

diff --git a/gv.c b/gv.c
index 12f9491dbe..f352452a35 100644
--- 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 d54246271b..5432280131 100644
--- 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 c30662d4ad..8ed73f6a60 100644
--- 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 302f47ee7c..d40e8c57c3 100644
--- 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 f63ab8d197..bd8afb7bbe 100644
--- 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);
 		}