Make diag.t runnable outside t/

[perl5.git] / mro.c

diff --git a/mro.c b/mro.c
index 1d60387..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.  */
@@ -1088,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::... */
@@ -1132,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
                                    );
                                }
@@ -1146,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
                                );
                            }
                        }
@@ -1156,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);
                }
            }
        }
@@ -1174,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. */
@@ -1217,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
                                    );
                                }
@@ -1231,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
                                );
                            }
                        }