Make diag.t runnable outside t/

[perl5.git] / mro.c

diff --git a/mro.c b/mro.c
index 386f898..3311d2b 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -114,6 +114,13 @@ Perl_mro_get_from_name(pTHX_ SV *name) {
     return INT2PTR(const struct mro_alg *, SvUVX(*data));
 }
 
+/*
+=for apidoc mro_register
+Registers a custom mro plugin.  See L<perlmroapi> for details.
+
+=cut
+*/
+
 void
 Perl_mro_register(pTHX_ const struct mro_alg *mro) {
     SV *wrapper = newSVuv(PTR2UV(mro));
@@ -408,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.  */