From 6624142a770b3cb9a18e1968e0294117f8f8efa1 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 13 Nov 2010 17:28:46 -0800
Subject: [PATCH] [perl #77238] Aliased @ISA does not work

This makes aliased @ISA arrays work by storing a non-magical AV as the
mg_obj if there need to be multiple entries.
---
 MANIFEST |  1 +
 mg.c     | 28 +++++++++++++++++-----------
 sv.c     | 27 +++++++++++++++++++++++++--
 3 files changed, 43 insertions(+), 13 deletions(-)

diff --git a/MANIFEST b/MANIFEST
index 6f7c568..3f73d95 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4578,6 +4578,7 @@ t/mro/complex_dfs.t		mro tests
 t/mro/dbic_c3.t			mro tests
 t/mro/dbic_dfs.t		mro tests
 t/mro/inconsistent_c3.t		mro tests
+t/mro/isa_aliases.t		tests for shared @ISA arrays
 t/mro/isa_c3.t			test for optimisatised mro_get_linear_isa_c3
 t/mro/isa_dfs.t			test for optimisatised mro_get_linear_isa_dfs
 t/mro/isarev.t			PL_isarev/mro::get_isarev tests
diff --git a/mg.c b/mg.c
index abd4a9d..334eb80 100644
--- a/mg.c
+++ b/mg.c
@@ -1616,18 +1616,24 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
     if (sv)
 	av_clear(MUTABLE_AV(sv));
 
-    /* XXX Once it's possible, we need to
-       detect that our @ISA is aliased in
-       other stashes, and act on the stashes
-       of all of the aliases */
-
-    /* The first case occurs via setisa,
-       the second via setisa_elem, which
-       calls this same magic */
+    if (SvTYPE(mg->mg_obj) != SVt_PVGV && SvSMAGICAL(mg->mg_obj))
+	/* This occurs with setisa_elem magic, which calls this
+	   same function. */
+	mg = mg_find(mg->mg_obj, PERL_MAGIC_isa);
+
+    if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */
+	SV **svp = AvARRAY((AV *)mg->mg_obj);
+	I32 items = AvFILLp((AV *)mg->mg_obj) + 1;
+	while (items--) {
+	    stash = GvSTASH((GV *)*svp++);
+	    if (stash && HvENAME(stash)) mro_isa_changed_in(stash);
+	}
+
+	return 0;
+    }
+
     stash = GvSTASH(
-        SvTYPE(mg->mg_obj) == SVt_PVGV
-            ? (const GV *)mg->mg_obj
-            : (const GV *)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
+        (const GV *)mg->mg_obj
     );
 
     /* The stash may have been detached from the symbol table, so check its
diff --git a/sv.c b/sv.c
index e811580..d72d176 100644
--- a/sv.c
+++ b/sv.c
@@ -3631,6 +3631,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
          /* The stash may have been detached from the symbol table, so
             check its name. */
          && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+         && GvAV((const GV *)sstr)
         )
             mro_changes = 2;
         else {
@@ -3663,7 +3664,20 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
 	    GvIMPORTED_on(dstr);
 	}
     GvMULTI_on(dstr);
-    if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
+    if(mro_changes == 2) {
+	MAGIC *mg;
+	SV * const sref = (SV *)GvAV((const GV *)dstr);
+	if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) {
+	    if (SvTYPE(mg->mg_obj) != SVt_PVAV) {
+		AV * const ary = newAV();
+		av_push(ary, mg->mg_obj); /* takes the refcount */
+		mg->mg_obj = (SV *)ary;
+	    }
+	    av_push((AV *)mg->mg_obj, SvREFCNT_inc_simple_NN(dstr));
+	}
+	else sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
+	mro_isa_changed_in(GvSTASH(dstr));
+    }
     else if(mro_changes == 3) {
 	HV * const stash = GvHV(dstr);
 	if(old_stash ? (HV *)HvENAME_get(old_stash) : stash)
@@ -3797,7 +3811,16 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
 	    check its name before doing anything. */
 	 && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
 	) {
-	    sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
+	    MAGIC *mg;
+	    if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) {
+		if (SvTYPE(mg->mg_obj) != SVt_PVAV) {
+		    AV * const ary = newAV();
+		    av_push(ary, mg->mg_obj); /* takes the refcount */
+		    mg->mg_obj = (SV *)ary;
+		}
+		av_push((AV *)mg->mg_obj, SvREFCNT_inc_simple_NN(dstr));
+	    }
+	    else sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
 	    mro_isa_changed_in(GvSTASH(dstr));
 	}
 	break;
-- 
2.7.4