[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.

diff --git a/MANIFEST b/MANIFEST
index 6f7c568..3f73d95 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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;