This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mktables: Upgrade to handle new Unicode 6.0 tables
[perl5.git] / mro.c
diff --git a/mro.c b/mro.c
index 4435c2b..8276795 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -443,6 +443,20 @@ by the C<setisa> magic, should not need to invoke directly.
 
 =cut
 */
+
+/* Macro to avoid repeating the code five times. */
+#define CLEAR_LINEAR(mEta)                                     \
+    if (mEta->mro_linear_all) {                                 \
+       SvREFCNT_dec(MUTABLE_SV(mEta->mro_linear_all));          \
+       mEta->mro_linear_all = NULL;                              \
+       /* This is just acting as a shortcut pointer.  */          \
+       mEta->mro_linear_current = NULL;                            \
+    } else if (mEta->mro_linear_current) {                           \
+       /* Only the current MRO is stored, so this owns the data.  */ \
+       SvREFCNT_dec(mEta->mro_linear_current);                        \
+       mEta->mro_linear_current = NULL;                                \
+    }
+
 void
 Perl_mro_isa_changed_in(pTHX_ HV* stash)
 {
@@ -467,16 +481,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
     /* wipe out the cached linearizations for this stash */
     meta = HvMROMETA(stash);
-    if (meta->mro_linear_all) {
-       SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
-       meta->mro_linear_all = NULL;
-       /* This is just acting as a shortcut pointer.  */
-       meta->mro_linear_current = NULL;
-    } else if (meta->mro_linear_current) {
-       /* Only the current MRO is stored, so this owns the data.  */
-       SvREFCNT_dec(meta->mro_linear_current);
-       meta->mro_linear_current = NULL;
-    }
+    CLEAR_LINEAR(meta);
     if (meta->isa) {
        /* Steal it for our own purposes. */
        isa = (HV *)sv_2mortal((SV *)meta->isa);
@@ -533,16 +538,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
             if(!revstash) continue;
             revmeta = HvMROMETA(revstash);
-           if (revmeta->mro_linear_all) {
-               SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_all));
-               revmeta->mro_linear_all = NULL;
-               /* This is just acting as a shortcut pointer.  */
-               revmeta->mro_linear_current = NULL;
-           } else if (revmeta->mro_linear_current) {
-               /* Only the current MRO is stored, so this owns the data.  */
-               SvREFCNT_dec(revmeta->mro_linear_current);
-               revmeta->mro_linear_current = NULL;
-           }
+           CLEAR_LINEAR(revmeta);
             if(!is_universal)
                 revmeta->cache_gen++;
             if(revmeta->mro_nextmethod)
@@ -570,11 +566,6 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
                 HV * const isa = (HV *)HeVAL(iter);
                 const HEK *namehek;
 
-                /* Re-calculate the linearisation, unless a previous iter-
-                   ation was for a subclass of this class. */
-                if(!HvMROMETA(revstash)->isa)
-                    (void)mro_get_linear_isa(revstash);
-
                 /* We're starting at the 2nd element, skipping revstash */
                 linear_mro = mro_get_linear_isa(revstash);
                 svp = AvARRAY(linear_mro) + 1;
@@ -702,6 +693,10 @@ non-existent packages that have corresponding entries in C<stash>.
 It also sets the effective names (C<HvENAME>) on all the stashes as
 appropriate.
 
+If the C<gv> is present and is not in the symbol table, then this function
+simply returns. This checked will be skipped if C<newname_len> is set to 1
+and C<newname> is null.
+
 =cut
 */
 void
@@ -730,17 +725,18 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
      *
      * If newname is not null, then we trust that the caller gave us the
      * right name. Otherwise, we get it from the gv. But if the gv is not
-     * in the symbol table, then we just return.
+     * in the symbol table, then we just return. We skip that check,
+     * however, if newname_len is 1 and newname is null.
      */
     if(!newname && gv) {
        SV * const namesv = sv_newmortal();
        STRLEN len;
        gv_fullname4(namesv, gv, NULL, 0);
-       if(gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV) != gv) return;
+       if( newname_len != 1
+        && gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV) != gv ) return;
        newname = SvPV_const(namesv, len);
        newname_len = len - 2; /* skip trailing :: */
     }
-    if(newname_len < 0) newname_len = -newname_len;
 
     /* Get a list of all the affected classes. */
     /* We cannot simply pass them all to mro_isa_changed_in to avoid
@@ -753,7 +749,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
        as neither B nor B::B can be updated before the other, since they
        will reset caches on foo, which will see either B or B::B with the
        wrong name. The names must be set on *all* affected stashes before
-       we do anything else.
+       we do anything else. (And linearisations must be cleared, too.)
      */
     stashes = (HV *) sv_2mortal((SV *)newHV());
     mro_gather_and_rename(
@@ -761,33 +757,29 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
      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
-       isarev hashes belonging to parent classes). */
-    hv_iterinit(stashes);
-    while((iter = hv_iternext(stashes))) {
-       if(HeVAL(iter) != &PL_sv_yes && HvENAME(HeVAL(iter))) {
-           struct mro_meta* meta;
-           meta = HvMROMETA((HV *)HeVAL(iter));
-           if (meta->mro_linear_all) {
-               SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
-               meta->mro_linear_all = NULL;
-               /* This is just acting as a shortcut pointer.  */
-               meta->mro_linear_current = NULL;
-           } else if (meta->mro_linear_current) {
-               /* Only the current MRO is stored, so this owns the data.  */
-               SvREFCNT_dec(meta->mro_linear_current);
-               meta->mro_linear_current = NULL;
-           }
-        }
-    }
-
     /* Once the caches have been wiped on all the classes, call
        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 +817,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,11 +830,16 @@ 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
          );
+       CLEAR_LINEAR(meta);
 
        /* Update the effective name. */
        if(HvENAME_get(oldstash)) {
@@ -859,7 +857,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 +893,18 @@ 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
                  );
+               CLEAR_LINEAR(meta);
+           }
        }
     }
 
@@ -922,13 +926,19 @@ 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
              );
+           CLEAR_LINEAR(meta);
         }
     }