Update isarev when clobbered class has subsubclasses

This fixes a case that mro_package_moved did not take into account:
If a class with multiple levels of subclasses was assigned over, then,
depending on the order in which the subclasses were processed in the
second loop in mro_package_moved, the subclasses might not be removed
from the isarev hashes of superclasses of the clobbered class.

This was because a call to mro_isa_changed_in on one class could call
mro_get_linear_isa on another class in the list, overwriting its
meta->isa hash, which is used to determine what to delete from
PL_isarev.

E.g., if D isa C isa B isa A, this assignment:

  *B:: = *something::;

would cause B, C and D to be iterated over, but not in any particular
order. The order could be D, C, B, in which case mro_isa_changed_in(D)
would overwrite the meta->isa hash in C with one that did not list A.
So mro_isa_changed_in(C) would not see A in meta->isa and would not
delete PL_isarev->{A}{C}.

This commit stores the meta->isa hash as the value in the ‘big list’,
instead of the stash. The stash itself can be retrieved from the key,
since it is already a memory address (a pointer cast to a char array).
The recorded isa hash in inserted into each stash before the call to
mro_isa_changed_in.

diff --git a/mro.c b/mro.c
index 4435c2b..80264c2 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -766,9 +766,10 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
        isarev hashes belonging to parent classes). */
     hv_iterinit(stashes);
     while((iter = hv_iternext(stashes))) {
-       if(HeVAL(iter) != &PL_sv_yes && HvENAME(HeVAL(iter))) {
+       HV * const stash = *(HV **)HEK_KEY(HeKEY_hek(iter));
+       if(HvENAME(stash)) {
            struct mro_meta* meta;
-           meta = HvMROMETA((HV *)HeVAL(iter));
+           meta = HvMROMETA(stash);
            if (meta->mro_linear_all) {
                SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
                meta->mro_linear_all = NULL;
@@ -786,8 +787,25 @@ 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(HvENAME(HeVAL(iter)))
-           mro_isa_changed_in((HV *)HeVAL(iter));
+       HV * const stash = *(HV **)HEK_KEY(HeKEY_hek(iter));
+       if(HvENAME(stash)) {
+           /* We have to restore the original meta->isa (that
+              mro_gather_and_rename set aside for us) this way, in case
+              one class in this list is a superclass of a another class
+              that we have already encountered. In such a case, meta->isa
+              will have been overwritten without old entries being deleted 
+              from PL_isarev. */
+           struct mro_meta * const meta = HvMROMETA(stash);
+           if(meta->isa != (HV *)HeVAL(iter)){
+               SvREFCNT_dec(meta->isa);
+               meta->isa
+                = HeVAL(iter) == &PL_sv_yes
+                   ? NULL
+                   : (HV *)HeVAL(iter);
+               HeVAL(iter) = NULL; /* We donated our reference count. */
+           }
+           mro_isa_changed_in(stash);
+       }
     }
 }
 
@@ -825,6 +843,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
     if(oldstash) {
        /* Add to the big list. */
+       struct mro_meta * meta;
        HE * const entry
         = (HE *)
             hv_common(
@@ -837,10 +856,14 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
        }
        HeVAL(entry)
         = HeVAL(entry) == &PL_sv_no ? &PL_sv_yes : &PL_sv_undef;
+       meta = HvMROMETA(oldstash);
        (void)
          hv_store(
           stashes, (const char *)&oldstash, sizeof(HV *),
-          SvREFCNT_inc_simple_NN((SV*)oldstash), 0
+          meta->isa
+           ? SvREFCNT_inc_simple_NN((SV *)meta->isa)
+           : &PL_sv_yes,
+          0
          );
 
        /* Update the effective name. */
@@ -859,7 +882,6 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
          * 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) {
-           const struct mro_meta * meta = HvMROMETA(oldstash);
            if(meta->isa && HvARRAY(meta->isa))
                mro_clean_isarev(meta->isa, name, namlen, NULL);
            isarev = (HV *)hv_delete(PL_isarev, name, namlen, 0);
@@ -896,11 +918,17 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
            HeVAL(entry)
             = HeVAL(entry) == &PL_sv_undef ? &PL_sv_yes : &PL_sv_no;
            if(!stash_had_name)
+           {
+               struct mro_meta * const meta = HvMROMETA(stash);
                (void)
                  hv_store(
                   stashes, (const char *)&stash, sizeof(HV *),
-                  SvREFCNT_inc_simple_NN((SV *)stash), 0
+                  meta->isa
+                   ? SvREFCNT_inc_simple_NN((SV *)meta->isa)
+                   : &PL_sv_yes,
+                  0
                  );
+           }
        }
     }
 
@@ -922,12 +950,17 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
            I32 len;
            const char* const revkey = hv_iterkey(iter, &len);
            HV* revstash = gv_stashpvn(revkey, len, 0);
+           struct mro_meta * meta;
 
            if(!revstash) continue;
+           meta = HvMROMETA(revstash);
            (void)
              hv_store(
               stashes, (const char *)&revstash, sizeof(HV *),
-              SvREFCNT_inc_simple_NN((SV *)revstash), 0
+              meta->isa
+               ? SvREFCNT_inc_simple_NN((SV *)meta->isa)
+               : &PL_sv_yes,
+              0
              );
         }
     }

diff --git a/t/mro/isarev.t b/t/mro/isarev.t
index 05312cc..3c3692e 100644 (file)
--- a/t/mro/isarev.t
+++ b/t/mro/isarev.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 use warnings;
-plan(tests => 22);
+plan(tests => 23);
 
 use mro;
 
@@ -132,3 +132,12 @@ i beta => qw [], "undeffing an ISA glob deletes isarev entries";
 $_ = \*az::ISA;
 undef *az::;
 i buki => qw [], "undeffing a package glob deletes isarev entries";
+
+# Package aliasing/clobbering when the clobbered package has grandchildren
+# by inheritance.
+@bar::ISA = 'phoo';
+@subclassA::ISA = "subclassB";
+@subclassB::ISA = "bar";
+*bar:: = *baz::;
+i phoo => qw [],
+ 'clobbering a class w/multiple layers of subclasses updates its parent';