X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9404893f24257746efaa6b119c8f9a9960a99a6f..9e7945ee50c30a17a84968fb0c7e5c38223af6f9:/mro.c

diff --git a/mro.c b/mro.c
index 1c5f4eb..be2038f 100644
--- a/mro.c
+++ b/mro.c
@@ -1,7 +1,7 @@
 /*    mro.c
  *
  *    Copyright (c) 2007 Brandon L Black
- *    Copyright (c) 2007, 2008 Larry Wall and others
+ *    Copyright (c) 2007, 2008, 2009, 2010, 2011 Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -312,8 +312,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
 			sv_upgrade(val, SVt_PV);
 			SvPV_set(val, HEK_KEY(share_hek_hek(key)));
 			SvCUR_set(val, HEK_LEN(key));
-			SvREADONLY_on(val);
-			SvFAKE_on(val);
+			SvIsCOW_on(val);
 			SvPOK_on(val);
 			if (HEK_UTF8(key))
 			    SvUTF8_on(val);
@@ -542,6 +541,12 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     /* wipe next::method cache too */
     if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
 
+    /* Changes to @ISA might turn overloading on */
+    HvAMAGIC_on(stash);
+
+    /* DESTROY can be cached in SvSTASH. */
+    if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+
     /* Iterate the isarev (classes that are our children),
        wiping out their linearization, method and isa caches
        and upating PL_isarev. */
@@ -573,6 +578,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
                 revmeta->cache_gen++;
             if(revmeta->mro_nextmethod)
                 hv_clear(revmeta->mro_nextmethod);
+	    if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
 
 	    (void)
 	      hv_store(
@@ -712,8 +718,8 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
 =for apidoc mro_package_moved
 
 Call this function to signal to a stash that it has been assigned to
-another spot in the stash hierarchy. C<stash> is the stash that has been
-assigned. C<oldstash> is the stash it replaces, if any. C<gv> is the glob
+another spot in the stash hierarchy.  C<stash> is the stash that has been
+assigned. C<oldstash> is the stash it replaces, if any.  C<gv> is the glob
 that is actually being assigned to.
 
 This can also be called with a null first argument to
@@ -727,7 +733,7 @@ It also sets the effective names (C<HvENAME>) on all the stashes as
 appropriate.
 
 If the C<gv> is present and is not in the symbol table, then this function
-simply returns. This checked will be skipped if C<flags & 1>.
+simply returns.  This checked will be skipped if C<flags & 1>.
 
 =cut
 */
@@ -880,8 +886,8 @@ STATIC void
 S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                               HV *stash, HV *oldstash, SV *namesv)
 {
-    register XPVHV* xhv;
-    register HE *entry;
+    XPVHV* xhv;
+    HE *entry;
     I32 riter = -1;
     I32 items = 0;
     const bool stash_had_name = stash && HvENAME(stash);
@@ -949,9 +955,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) {
@@ -1280,7 +1290,7 @@ of the given stash, so that they might notice
 the changes in this one.
 
 Ideally, all instances of C<PL_sub_generation++> in
-perl source outside of C<mro.c> should be
+perl source outside of F<mro.c> should be
 replaced by calls to this.
 
 Perl automatically handles most of the common
@@ -1321,6 +1331,9 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
     /* Inc the package generation, since a local method changed */
     HvMROMETA(stash)->pkg_gen++;
 
+    /* DESTROY can be cached in SvSTASH. */
+    if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+
     /* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
        invalidate all method caches globally */
     if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
@@ -1344,8 +1357,13 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
             mrometa->cache_gen++;
             if(mrometa->mro_nextmethod)
                 hv_clear(mrometa->mro_nextmethod);
+            if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
         }
     }
+
+    /* The method change may be due to *{$package . "::()"} = \&nil; in
+       overload.pm. */
+    HvAMAGIC_on(stash);
 }
 
 void
@@ -1415,8 +1433,8 @@ XS(XS_mro_method_changed_in)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */