mro_package_moved must act on all effective names

See the test case in the commit. It passes in 5.8.x and blead (as of
this commit), but not 5.10-5.13.7.

In every case the name to be passed to mro_gather_and_rename is cre-
ated using an SV, so we might as well pass that instead of extracting
the char array and length from it.

That allows us to pass an AV instead, if there are multiple names to
take into account.

5 files changed, 213 insertions, 68 deletions

diff --git a/embed.fnc b/embed.fnc
index c91adb1718..4c5f0ed1ec 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2371,7 +2371,7 @@ s	|void	|mro_gather_and_rename|NN HV * const stashes \
 				      |NN HV * const seen_stashes \
 				      |NULLOK HV *stash \
 				      |NULLOK HV *oldstash \
-				      |NN const char *name|I32 namlen
+				      |NN SV *namesv
 #endif
 : Used in hv.c, mg.c, pp.c, sv.c
 pd	|void   |mro_isa_changed_in|NN HV* stash
diff --git a/embed.h b/embed.h
index ca582b780d..09c7fb1775 100644
--- a/embed.h
+++ b/embed.h
@@ -1636,7 +1636,7 @@
 #  endif
 #  if defined(PERL_IN_MRO_C)
 #define mro_clean_isarev(a,b,c,d)	S_mro_clean_isarev(aTHX_ a,b,c,d)
-#define mro_gather_and_rename(a,b,c,d,e,f)	S_mro_gather_and_rename(aTHX_ a,b,c,d,e,f)
+#define mro_gather_and_rename(a,b,c,d,e)	S_mro_gather_and_rename(aTHX_ a,b,c,d,e)
 #define mro_get_linear_isa_dfs(a,b)	S_mro_get_linear_isa_dfs(aTHX_ a,b)
 #  endif
 #  if defined(PERL_IN_NUMERIC_C)
diff --git a/mro.c b/mro.c
index 9fd15dee64..250ee5c5c0 100644
--- a/mro.c
+++ b/mro.c
@@ -700,16 +700,16 @@ void
 Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
                        const GV * const gv, U32 flags)
 {
-    SV * const namesv = sv_newmortal();
-    const char * newname;
-    STRLEN newname_len;
+    SV *namesv;
+    HEK **namep;
+    I32 name_count;
     HV *stashes;
     HE* iter;
 
     PERL_ARGS_ASSERT_MRO_PACKAGE_MOVED;
     assert(stash || oldstash);
 
-    /* Determine the name of the location that stash was assigned to
+    /* Determine the name(s) of the location that stash was assigned to
      * or from which oldstash was removed.
      *
      * We cannot reliably use the name in oldstash, because it may have
@@ -722,15 +722,61 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
      *   *$globref = *frelp::;
      *      # calls mro_package_moved(%frelp::, %baz::, *$globref, NULL, 0)
      *
-     * So we get it from the gv. But if the gv is not
-     * in the symbol table, then we just return. We skip that check,
-     * however, if flags & 1.
+     * So we get it from the gv. But, since the gv may no longer be in the
+     * symbol table, we check that first. The only reliable way to tell is
+     * to see whether its stash has an effective name and whether the gv
+     * resides in that stash under its name. That effective name may be
+     * different from what gv_fullname4 would use.
+     * If flags & 1, the caller has asked us to skip the check.
      */
-    gv_fullname4(namesv, gv, NULL, 0);
-    if( !(flags & 1)
-	 && gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV) != gv ) return;
-    newname = SvPV_const(namesv, newname_len);
-    newname_len -= 2; /* skip trailing :: */
+    if(!(flags & 1)) {
+	SV **svp;
+	if(
+	 !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) ||
+	 !(svp = hv_fetch(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), 0)) ||
+	 *svp != (SV *)gv
+	) return;
+    }
+    assert(SvOOK(GvSTASH(gv)));
+    assert(GvNAMELEN(gv) > 1);
+    assert(GvNAME(gv)[GvNAMELEN(gv) - 1] == ':');
+    assert(GvNAME(gv)[GvNAMELEN(gv) - 2] == ':');
+    name_count = HvAUX(GvSTASH(gv))->xhv_name_count;
+    if (!name_count) {
+	name_count = 1;
+	namep = &HvAUX(GvSTASH(gv))->xhv_name;
+    }
+    else {
+	namep = (HEK **)HvAUX(GvSTASH(gv))->xhv_name;
+	if (name_count < 0) ++namep, name_count = -name_count - 1;
+    }
+    if (name_count == 1) {
+	if (HEK_LEN(*namep) == 4 && strnEQ(HEK_KEY(*namep), "main", 4)) {
+	    namesv = sv_2mortal(newSVpvs(""));
+	}
+	else {
+	    namesv = sv_2mortal(newSVhek(*namep));
+	    sv_catpvs(namesv, "::");
+	}
+	sv_catpvn(namesv, GvNAME(gv), GvNAMELEN(gv) - 2);
+	                                  /* skip trailing :: */
+    }
+    else {
+	SV *aname;
+	namesv = sv_2mortal((SV *)newAV());
+	while (name_count--) {
+	    if(HEK_LEN(*namep) == 4 && strnEQ(HEK_KEY(*namep), "main", 4)){
+		aname = newSVpvs(""); namep++;
+	    }
+	    else {
+		aname = newSVhek(*namep++);
+		sv_catpvs(aname, "::");
+	    }
+	    sv_catpvn(aname, GvNAME(gv), GvNAMELEN(gv) - 2);
+	                                  /* skip trailing :: */
+	    av_push((AV *)namesv, aname);
+	}
+    }
 
     /* Get a list of all the affected classes. */
     /* We cannot simply pass them all to mro_isa_changed_in to avoid
@@ -748,7 +794,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
     stashes = (HV *) sv_2mortal((SV *)newHV());
     mro_gather_and_rename(
      stashes, (HV *) sv_2mortal((SV *)newHV()),
-     stash, oldstash, newname, newname_len
+     stash, oldstash, namesv
     );
 
     /* Once the caches have been wiped on all the classes, call
@@ -779,16 +825,17 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
 
 void
 S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
-                              HV *stash, HV *oldstash, const char *name,
-                              I32 namlen)
+                              HV *stash, HV *oldstash, SV *namesv)
 {
     register XPVHV* xhv;
     register HE *entry;
     I32 riter = -1;
+    I32 items;
     const bool stash_had_name = stash && HvENAME(stash);
+    bool fetched_isarev = FALSE;
     HV *seen = NULL;
     HV *isarev = NULL;
-    SV **svp;
+    SV **svp = NULL;
 
     PERL_ARGS_ASSERT_MRO_GATHER_AND_RENAME;
 
@@ -837,29 +884,56 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
 	/* Update the effective name. */
 	if(HvENAME_get(oldstash)) {
-	  const HEK * const enamehek = HvENAME_HEK(oldstash);
-	  if(PL_stashcache)
-	    (void)
-	     hv_delete(PL_stashcache, name, namlen, G_DISCARD);
-	  hv_ename_delete(oldstash, name, namlen, 0);
-
-	 /* If the name deletion caused a name change, then we are not
-	  * going to call mro_isa_changed_in with this name (and not at all
-	  * if it has become anonymous) so we need to delete old isarev
-	  * entries here, both those in the superclasses and this class’s
-	  * own list of subclasses. We simply delete the latter from
-	  * from PL_isarev, since we still need it. hv_delete mortifies it
-	  * for us, so sv_2mortal is not necessary. */
-	  if(HvENAME_HEK(oldstash) != enamehek) {
-	    if(meta->isa && HvARRAY(meta->isa))
-		mro_clean_isarev(meta->isa, name, namlen, NULL);
-	    isarev = (HV *)hv_delete(PL_isarev, name, namlen, 0);
-	  }
+	    const HEK * const enamehek = HvENAME_HEK(oldstash);
+	    if(SvTYPE(namesv) == SVt_PVAV) {
+		items = AvFILLp((AV *)namesv) + 1;
+		svp = AvARRAY((AV *)namesv);
+	    }
+	    else {
+		items = 1;
+		svp = &namesv;
+	    }
+	    while (items--) {
+		STRLEN len;
+		const char *name = SvPVx_const(*svp++, len);
+		if(PL_stashcache)
+		    (void)hv_delete(PL_stashcache, name, len, G_DISCARD);
+	        hv_ename_delete(oldstash, name, len, 0);
+
+		if (!fetched_isarev) {
+		    /* If the name deletion caused a name change, then we
+		     * are not going to call mro_isa_changed_in with this
+		     * name (and not at all if it has become anonymous) so
+		     * we need to delete old isarev entries here, both
+		     * those in the superclasses and this class’s own list
+		     * of subclasses. We simply delete the latter from
+		     * PL_isarev, since we still need it. hv_delete morti-
+		     * fies it for us, so sv_2mortal is not necessary. */
+		    if(HvENAME_HEK(oldstash) != enamehek) {
+			if(meta->isa && HvARRAY(meta->isa))
+			    mro_clean_isarev(meta->isa, name, len, NULL);
+			isarev = (HV *)hv_delete(PL_isarev, name, len, 0);
+			fetched_isarev=TRUE;
+		    }
+		}
+	    }
 	}
     }
    check_stash:
     if(stash) {
-	hv_ename_add(stash, name, namlen, 0);
+	if(SvTYPE(namesv) == SVt_PVAV) {
+	    items = AvFILLp((AV *)namesv) + 1;
+	    svp = AvARRAY((AV *)namesv);
+	}
+	else {
+	    items = 1;
+	    svp = &namesv;
+	}
+	while (items--) {
+	    STRLEN len;
+	    const char *name = SvPVx_const(*svp++, len);
+	    hv_ename_add(stash, name, len, 0);
+	}
 
        /* Add it to the big list if it needs
 	* mro_isa_changed_in called on it. That happens if it was
@@ -907,14 +981,41 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 	return;
 
     /* Add all the subclasses to the big list. */
+    if(!fetched_isarev) {
+	/* If oldstash is not null, then we can use its HvENAME to look up
+	   the isarev hash, since all its subclasses will be listed there.
+
+	   If oldstash is null, then this is an empty spot with no stash in
+	   it, so subclasses could be listed in isarev hashes belonging to
+	   any of the names, so we have to check all of them. */
+	if(oldstash) {
+	    fetched_isarev = TRUE;
+	    svp
+	     = hv_fetch(
+	         PL_isarev, HvENAME(oldstash), HvENAMELEN_get(oldstash), 0
+	       );
+	    if (svp) isarev = MUTABLE_HV(*svp);
+	}
+	else if(SvTYPE(namesv) == SVt_PVAV) {
+	    items = AvFILLp((AV *)namesv) + 1;
+	    svp = AvARRAY((AV *)namesv);
+	}
+	else {
+	    items = 1;
+	    svp = &namesv;
+	}
+    }
     if(
-        isarev
-     || (
-           (svp = hv_fetch(PL_isarev, name, namlen, 0))
-        && (isarev = MUTABLE_HV(*svp))
-        )
+        isarev || !fetched_isarev
     ) {
+      while (fetched_isarev || items--) {
 	HE *iter;
+
+	if (!fetched_isarev) {
+	    HE * const he = hv_fetch_ent(PL_isarev, *svp++, 0, 0);
+	    if (!he || !(isarev = MUTABLE_HV(HeVAL(he)))) continue;
+	}
+
 	hv_iterinit(isarev);
 	while((iter = hv_iternext(isarev))) {
 	    I32 len;
@@ -934,6 +1035,9 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 	      );
 	    CLEAR_LINEAR(meta);
         }
+
+	if (fetched_isarev) break;
+      }
     }
 
     if(
@@ -983,20 +1087,29 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 		    )
 		    {
 			/* Add :: and the key (minus the trailing ::)
-			   to newname. */
-			SV *namesv
-			 = newSVpvn_flags(name, namlen, SVs_TEMP);
-			{
-			    const char *name;
-			    STRLEN namlen;
-			    sv_catpvs(namesv, "::");
-			    sv_catpvn(namesv, key, len-2);
-			    name = SvPV_const(namesv, namlen);
-			    mro_gather_and_rename(
-			     stashes, seen_stashes,
-			     substash, oldsubstash, name, namlen
-			    );
+			   to each name. */
+			SV *subname;
+			if(SvTYPE(namesv) == SVt_PVAV) {
+			    SV *aname;
+			    items = AvFILLp((AV *)namesv) + 1;
+			    svp = AvARRAY((AV *)namesv);
+			    subname = sv_2mortal((SV *)newAV());
+			    while (items--) {
+				aname = newSVsv(*svp++);
+				sv_catpvs(aname, "::");
+				sv_catpvn(aname, key, len-2);
+				av_push((AV *)subname, aname);
+			    }
 			}
+			else {
+			    subname = sv_2mortal(newSVsv(namesv));
+			    sv_catpvs(subname, "::");
+			    sv_catpvn(subname, key, len-2);
+			}
+			mro_gather_and_rename(
+			     stashes, seen_stashes,
+			     substash, oldsubstash, subname
+			);
 		    }
 
 		    (void)hv_store(seen, key, len, &PL_sv_yes, 0);
@@ -1037,23 +1150,33 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
 		    substash = GvHV(HeVAL(entry));
 		    if(substash) {
-			SV *namesv;
-			const char *subname;
-			STRLEN subnamlen;
+			SV *subname;
 
 			/* Avoid checking main::main::main::... */
 			if(substash == stash) continue;
 
 			/* Add :: and the key (minus the trailing ::)
-			   to newname. */
-			namesv
-			 = newSVpvn_flags(name, namlen, SVs_TEMP);
-			sv_catpvs(namesv, "::");
-			sv_catpvn(namesv, key, len-2);
-			subname = SvPV_const(namesv, subnamlen);
+			   to each name. */
+			if(SvTYPE(namesv) == SVt_PVAV) {
+			    SV *aname;
+			    items = AvFILLp((AV *)namesv) + 1;
+			    svp = AvARRAY((AV *)namesv);
+			    subname = sv_2mortal((SV *)newAV());
+			    while (items--) {
+				aname = newSVsv(*svp++);
+				sv_catpvs(aname, "::");
+				sv_catpvn(aname, key, len-2);
+				av_push((AV *)subname, aname);
+			    }
+			}
+			else {
+			    subname = sv_2mortal(newSVsv(namesv));
+			    sv_catpvs(subname, "::");
+			    sv_catpvn(subname, key, len-2);
+			}
 			mro_gather_and_rename(
 			  stashes, seen_stashes,
-			  substash, NULL, subname, subnamlen
+			  substash, NULL, subname
 			);
 		    }
 		}
diff --git a/proto.h b/proto.h
index 8a76cea2bf..194d7abf42 100644
--- a/proto.h
+++ b/proto.h
@@ -5684,12 +5684,12 @@ STATIC void	S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name, co
 #define PERL_ARGS_ASSERT_MRO_CLEAN_ISAREV	\
 	assert(isa); assert(name)
 
-STATIC void	S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, HV *stash, HV *oldstash, const char *name, I32 namlen)
+STATIC void	S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, HV *stash, HV *oldstash, SV *namesv)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_5);
 #define PERL_ARGS_ASSERT_MRO_GATHER_AND_RENAME	\
-	assert(stashes); assert(seen_stashes); assert(name)
+	assert(stashes); assert(seen_stashes); assert(namesv)
 
 STATIC AV*	S_mro_get_linear_isa_dfs(pTHX_ HV* stash, U32 level)
 			__attribute__nonnull__(pTHX_1);
diff --git a/t/mro/package_aliases.t b/t/mro/package_aliases.t
index 1622251c1f..aefca152ba 100644
--- a/t/mro/package_aliases.t
+++ b/t/mro/package_aliases.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 use warnings;
-plan(tests => 23);
+plan(tests => 24);
 
 {
     package New;
@@ -307,3 +307,25 @@ eval '
 ';
 is eval { 'Subclass'->womp }, 'clumpren',
  'Changes to @ISA after undef via alias';
+
+
+# Packages whose containing stashes have aliases must lose all names cor-
+# responding to that container when detached.
+{
+ {package smare::baz} # autovivify
+ *phring:: = *smare::;  # smare::baz now also named phring::baz
+ *bonk:: = delete $smare::{"baz::"};
+ # In 5.13.7, it has now lost its smare::baz name (reverting to phring::baz
+ # as the effective name), and gained bonk as an alias.
+ # In 5.13.8, both smare::baz *and* phring::baz names are deleted.
+
+ # Make some methods
+ no strict 'refs';
+ *{"phring::baz::frump"} = sub { "hello" };
+ sub frumper::frump { "good bye" };
+
+ @brumkin::ISA = qw "bonk frumper"; # now wrongly inherits from phring::baz
+
+ is frump brumkin, "good bye",
+  'detached stashes lose all names corresponding to the containing stash';
+}