This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlop: Typos, too long lines, corrections
[perl5.git] / mro.c
diff --git a/mro.c b/mro.c
index e0ab5bc..94be41c 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -117,6 +117,8 @@ Perl_mro_get_from_name(pTHX_ SV *name) {
 /*
 =for apidoc mro_register
 Registers a custom mro plugin.  See L<perlmroapi> for details.
+
+=cut
 */
 
 void
@@ -413,6 +415,29 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash)
         Perl_croak(aTHX_ "panic: invalid MRO!");
     isa = meta->mro_which->resolve(aTHX_ stash, 0);
 
+    if (meta->mro_which != &dfs_alg) { /* skip for dfs, for speed */
+       SV * const namesv =
+           (HvENAME(stash)||HvNAME(stash))
+             ? newSVhek(HvENAME_HEK(stash)
+                         ? HvENAME_HEK(stash)
+                         : HvNAME_HEK(stash))
+             : NULL;
+
+       if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv)))
+       {
+           AV * const old = isa;
+           SV **svp;
+           SV **ovp = AvARRAY(old);
+           SV * const * const oend = ovp + AvFILLp(old) + 1;
+           isa = (AV *)sv_2mortal((SV *)newAV());
+           av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1);
+           *AvARRAY(isa) = namesv;
+           svp = AvARRAY(isa)+1;
+           while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++);
+       }
+       else SvREFCNT_dec(namesv);
+    }
+
     if (!meta->isa) {
            HV *const isa_hash = newHV();
            /* Linearisation didn't build it for us, so do it here.  */
@@ -525,7 +550,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
        /* We have to iterate through isarev twice to avoid a chicken and
         * egg problem: if A inherits from B and both are in isarev, A might
-        * be processed before B and use Bs previous linearisation.
+        * be processed before B and use B's previous linearisation.
         */
 
        /* First iteration: Wipe everything, but stash away the isa hashes
@@ -648,7 +673,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
                 stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, &PL_sv_yes, 0);
     }
 
-    /* Delete our name from our former parents isarevs. */
+    /* Delete our name from our former parents' isarevs. */
     if(isa && HvARRAY(isa))
         mro_clean_isarev(isa, stashname, stashname_len, meta->isa,
                                 (stashname_utf8 ? SVf_UTF8 : 0) );
@@ -663,7 +688,7 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
 
     PERL_ARGS_ASSERT_MRO_CLEAN_ISAREV;
 
-    /* Delete our name from our former parents isarevs. */
+    /* Delete our name from our former parents' isarevs. */
     if(isa && HvARRAY(isa) && hv_iterinit(isa)) {
         SV **svp;
         while((iter = hv_iternext(isa))) {
@@ -687,8 +712,8 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
 =for apidoc mro_package_moved
 
 Call this function to signal to a stash that it has been assigned to
-another spot in the stash hierarchy. C<stash> is the stash that has been
-assigned. C<oldstash> is the stash it replaces, if any. C<gv> is the glob
+another spot in the stash hierarchy.  C<stash> is the stash that has been
+assigned. C<oldstash> is the stash it replaces, if any.  C<gv> is the glob
 that is actually being assigned to.
 
 This can also be called with a null first argument to
@@ -702,7 +727,7 @@ 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<flags & 1>.
+simply returns.  This checked will be skipped if C<flags & 1>.
 
 =cut
 */
@@ -851,7 +876,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
     }
 }
 
-void
+STATIC void
 S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                               HV *stash, HV *oldstash, SV *namesv)
 {
@@ -934,7 +959,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                     * 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 classs own list
+                    * 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. */
@@ -969,7 +994,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
        /* Add it to the big list if it needs
        * mro_isa_changed_in called on it. That happens if it was
        * detached from the symbol table (so it had no HvENAME) before
-       * being assigned to the spot named by the ‘name’ variable, because
+       * being assigned to the spot named by the 'name' variable, because
        * its cached isa linearisation is now stale (the effective name
        * having changed), and subclasses will then use that cache when
        * mro_package_moved calls mro_isa_changed_in. (See
@@ -1255,7 +1280,7 @@ of the given stash, so that they might notice
 the changes in this one.
 
 Ideally, all instances of C<PL_sub_generation++> in
-perl source outside of C<mro.c> should be
+perl source outside of F<mro.c> should be
 replaced by calls to this.
 
 Perl automatically handles most of the common