Make diag.t runnable outside t/

[perl5.git] / mro.c

diff --git a/mro.c b/mro.c
index 67c77eb..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));
@@ -224,8 +231,9 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
     if (level > 100)
-        Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
-                  SVfARG(sv_2mortal(newSVhek(stashhek))));
+        Perl_croak(aTHX_
+                 "Recursive inheritance detected in package '%"HEKf"'",
+                  HEKfARG(stashhek));
 
     meta = HvMROMETA(stash);
 
@@ -407,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.  */
@@ -1087,21 +1118,19 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
            /* Iterate through the entries in this list */
            for(; entry; entry = HeNEXT(entry)) {
-               SV* keysv;
                const char* key;
-               STRLEN len;
+               I32 len;
 
                /* If this entry is not a glob, ignore it.
                   Try the next.  */
                if (!isGV(HeVAL(entry))) continue;
 
-                keysv = hv_iterkeysv(entry);
-               key = SvPV_const(keysv, len);
+               key = hv_iterkey(entry, &len);
                if ((len > 1 && key[len-2] == ':' && key[len-1] == ':')
                 || (len == 1 && key[0] == ':')) {
                    HV * const oldsubstash = GvHV(HeVAL(entry));
                    SV ** const stashentry
-                    = stash ? hv_fetch(stash, key, SvUTF8(keysv) ? -(I32)len : (I32)len, 0) : NULL;
+                    = stash ? hv_fetch(stash, key, HeUTF8(entry) ? -(I32)len : (I32)len, 0) : NULL;
                    HV *substash = NULL;
 
                    /* Avoid main::main::main::... */
@@ -1131,7 +1160,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                                    sv_catpvs(aname, "::");
                                    sv_catpvn_flags(
                                        aname, key, len-2,
-                                       SvUTF8(keysv)
+                                       HeUTF8(entry)
                                           ? SV_CATUTF8 : SV_CATBYTES
                                    );
                                }
@@ -1145,7 +1174,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                                sv_catpvs(subname, "::");
                                sv_catpvn_flags(
                                   subname, key, len-2,
-                                  SvUTF8(keysv) ? SV_CATUTF8 : SV_CATBYTES
+                                  HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES
                                );
                            }
                        }
@@ -1155,7 +1184,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                        );
                    }
 
-                   (void)hv_store(seen, key, SvUTF8(keysv) ? -(I32)len : (I32)len, &PL_sv_yes, 0);
+                   (void)hv_store(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len, &PL_sv_yes, 0);
                }
            }
        }
@@ -1173,23 +1202,21 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
            /* Iterate through the entries in this list */
            for(; entry; entry = HeNEXT(entry)) {
-               SV* keysv;
                const char* key;
-               STRLEN len;
+               I32 len;
 
                /* If this entry is not a glob, ignore it.
                   Try the next.  */
                if (!isGV(HeVAL(entry))) continue;
 
-                keysv = hv_iterkeysv(entry);
-               key = SvPV_const(keysv, len);
+               key = hv_iterkey(entry, &len);
                if ((len > 1 && key[len-2] == ':' && key[len-1] == ':')
                 || (len == 1 && key[0] == ':')) {
                    HV *substash;
 
                    /* If this entry was seen when we iterated through the
                       oldstash, skip it. */
-                   if(seen && hv_exists(seen, key, SvUTF8(keysv) ? -(I32)len : (I32)len)) continue;
+                   if(seen && hv_exists(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len)) continue;
 
                    /* We get here only if this stash has no corresponding
                       entry in the stash being replaced. */
@@ -1216,7 +1243,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                                    sv_catpvs(aname, "::");
                                    sv_catpvn_flags(
                                        aname, key, len-2,
-                                       SvUTF8(keysv)
+                                       HeUTF8(entry)
                                           ? SV_CATUTF8 : SV_CATBYTES
                                    );
                                }
@@ -1230,7 +1257,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
                                sv_catpvs(subname, "::");
                                sv_catpvn_flags(
                                   subname, key, len-2,
-                                  SvUTF8(keysv) ? SV_CATUTF8 : SV_CATBYTES
+                                  HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES
                                );
                            }
                        }