Fix package assignment with nested aliased packages

This commit fixes package assignments like *foo:: = *bar:: when both
foo and bar contain nested stashes that are aliases of each other.

mro_package_moved (actually, its auxiliary routine) need to keep a
list of stashes that have been seen as a separate list from those that
are going to have mro_isa_changed_in called on them. Otherwise, some
stashes will simply not be iterated through.

See the test that this adds and its comments. @ISA = @ISA should never
have any effect visible to Perl (with a capital), but it does in that
test case, prior to this commit.

This also fixes another bug that the test case triggered:
riter was not being reset before the second iteration in
mro_gather_and_rename.

Also, the stashes HV (aka the ‘big list’) now holds refcounts on its
elements, as that makes the code simpler as a result of the changes.

1 files changed, 59 insertions, 29 deletions

diff --git a/mro.c b/mro.c
index f65157a435..7c40688836 100644
--- a/mro.c
+++ b/mro.c
@@ -775,7 +775,10 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
        we do anything else.
      */
     stashes = (HV *) sv_2mortal((SV *)newHV());
-    mro_gather_and_rename(stashes, stash, oldstash, newname, newname_len);
+    mro_gather_and_rename(
+     stashes, (HV *) sv_2mortal((SV *)newHV()),
+     stash, oldstash, newname, newname_len
+    );
 
     /* Iterate through the stashes, wiping isa linearisations, but leaving
        the isa hash (which mro_isa_changed_in needs for adjusting the
@@ -802,17 +805,15 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
        mro_isa_changed_in on each. */
     hv_iterinit(stashes);
     while((iter = hv_iternext(stashes))) {
-	if(HeVAL(iter) != &PL_sv_yes && HvENAME(HeVAL(iter)))
+	if(HvENAME(HeVAL(iter)))
 	    mro_isa_changed_in((HV *)HeVAL(iter));
-	/* We are not holding a refcount, so eliminate the pointer before
-	 * stashes is freed. */
-	HeVAL(iter) = NULL;
     }
 }
 
 void
-S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
-                              const char *name, I32 namlen)
+S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
+                              HV *stash, HV *oldstash, const char *name,
+                              I32 namlen)
 {
     register XPVHV* xhv;
     register HE *entry;
@@ -824,19 +825,42 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
 
     PERL_ARGS_ASSERT_MRO_GATHER_AND_RENAME;
 
+    /* We use the seen_stashes hash to keep track of which packages have
+       been encountered so far. This must be separate from the main list of
+       stashes, as we need to distinguish between stashes being assigned
+       and stashes being replaced/deleted. (A nested stash can be on both
+       sides of an assignment. We cannot simply skip iterating through a
+       stash on the right if we have seen it on the left, as it will not
+       get its ename assigned to it.)
+
+       To avoid allocating extra SVs, instead of a bitfield we can make
+       bizarre use of immortals:
+
+        &PL_sv_undef:  seen on the left  (oldstash)
+        &PL_sv_no   :  seen on the right (stash)
+        &PL_sv_yes  :  seen on both sides
+
+     */
+
     if(oldstash) {
 	/* Add to the big list. */
 	HE * const entry
 	 = (HE *)
 	     hv_common(
-	      stashes, NULL, (const char *)&oldstash, sizeof(HV *), 0,
+	      seen_stashes, NULL, (const char *)&oldstash, sizeof(HV *), 0,
 	      HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0
 	     );
-	if(HeVAL(entry) == (SV *)oldstash) {
+	if(HeVAL(entry) == &PL_sv_undef || HeVAL(entry) == &PL_sv_yes) {
 	    oldstash = NULL;
 	    goto check_stash;
 	}
-	HeVAL(entry) = (SV *)oldstash;
+	HeVAL(entry)
+	 = HeVAL(entry) == &PL_sv_no ? &PL_sv_yes : &PL_sv_undef;
+	(void)
+	  hv_store(
+	   stashes, (const char *)&oldstash, sizeof(HV *),
+	   SvREFCNT_inc_simple_NN((SV*)oldstash), 0
+	  );
 
 	/* Update the effective name. */
 	if(HvENAME_get(oldstash)) {
@@ -865,11 +889,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
     if(stash) {
 	hv_ename_add(stash, name, namlen);
 
-       /* Add it to the big list. We use the stash itself as the value if
-	* it needs mro_isa_changed_in called on it. Otherwise we just use
-	* &PL_sv_yes to indicate that we have seen it. */
-
-       /* The stash needs mro_isa_changed_in called on it if it was
+       /* Add it to the big list if it needs
+	* mro_isa_changed_in called on it. That happens if it was
 	* detached from the symbol table (so it had no HvENAME) before
 	* being assigned to the spot named by the ‘name’ variable, because
 	* its cached isa linerisation is now stale (the effective name
@@ -885,12 +906,21 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
 	entry
 	 = (HE *)
 	     hv_common(
-	      stashes, NULL, (const char *)&stash, sizeof(HV *), 0,
+	      seen_stashes, NULL, (const char *)&stash, sizeof(HV *), 0,
 	      HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0
 	     );
-	if(HeVAL(entry) == &PL_sv_yes || HeVAL(entry) == (SV *)stash)
+	if(HeVAL(entry) == &PL_sv_yes || HeVAL(entry) == &PL_sv_no)
 	    stash = NULL;
-	else HeVAL(entry) = stash_had_name ? &PL_sv_yes : (SV *)stash;
+	else {
+	    HeVAL(entry)
+	     = HeVAL(entry) == &PL_sv_undef ? &PL_sv_yes : &PL_sv_no;
+	    if(!stash_had_name)
+		(void)
+		  hv_store(
+		   stashes, (const char *)&stash, sizeof(HV *),
+		   SvREFCNT_inc_simple_NN((SV *)stash), 0
+		  );
+	}
     }
 
     if(!stash && !oldstash)
@@ -913,14 +943,11 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
 	    HV* revstash = gv_stashpvn(revkey, len, 0);
 
 	    if(!revstash) continue;
-	    entry
-	     = (HE *)
-	         hv_common(
-	          stashes, NULL, (const char *)&revstash, sizeof(HV *), 0,
-	          HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0
-	         );
-	    HeVAL(entry) = (SV *)revstash;
-	    
+	    (void)
+	      hv_store(
+	       stashes, (const char *)&revstash, sizeof(HV *),
+	       SvREFCNT_inc_simple_NN((SV *)revstash), 0
+	      );
         }
     }
 
@@ -981,7 +1008,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
 			    sv_catpvn(namesv, key, len-2);
 			    name = SvPV_const(namesv, namlen);
 			    mro_gather_and_rename(
-			     stashes, substash, oldsubstash, name, namlen
+			     stashes, seen_stashes,
+			     substash, oldsubstash, name, namlen
 			    );
 			}
 		    }
@@ -995,9 +1023,10 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
     /* Skip the entire loop if the hash is empty.   */
     if (stash && HvUSEDKEYS(stash)) {
 	xhv = (XPVHV*)SvANY(stash);
+	riter = -1;
 
 	/* Iterate through the new stash, skipping $seen{$key} items,
-	   calling mro_gather_and_rename(stashes, entry, NULL, ...). */
+	   calling mro_gather_and_rename(stashes,seen,entry,NULL, ...). */
 	while (++riter <= (I32)xhv->xhv_max) {
 	    entry = (HvARRAY(stash))[riter];
 
@@ -1038,7 +1067,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV *stash, HV *oldstash,
 			sv_catpvn(namesv, key, len-2);
 			subname = SvPV_const(namesv, subnamlen);
 			mro_gather_and_rename(
-			  stashes, substash, NULL, subname, subnamlen
+			  stashes, seen_stashes,
+			  substash, NULL, subname, subnamlen
 			);
 		    }
 		}