Make diag.t runnable outside t/

[perl5.git] / mro.c

diff --git a/mro.c b/mro.c
index e0ab5bc..3311d2b 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.  */