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));
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
- Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
- HEK_KEY(stashhek));
+ Perl_croak(aTHX_
+ "Recursive inheritance detected in package '%"HEKf"'",
+ HEKfARG(stashhek));
meta = HvMROMETA(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. */
is UNIVERSAL or one of its parents */
svp = hv_fetch(PL_isarev, stashname,
- stashname_utf8 ? -stashname_len : stashname_len, 0);
+ stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
case where it doesn't exist. */
(void)hv_store(mroisarev, stashname,
- stashname_utf8 ? -stashname_len : stashname_len, &PL_sv_yes, 0);
+ stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, &PL_sv_yes, 0);
}
/* Delete our name from our former parents’ isarevs. */
svp = hv_fetch(PL_isarev, key, HeKUTF8(iter) ? -klen : klen, 0);
if(svp) {
HV * const isarev = (HV *)*svp;
- (void)hv_delete(isarev, name, (flags & SVf_UTF8) ? -len : len, G_DISCARD);
+ (void)hv_delete(isarev, name, (flags & SVf_UTF8) ? -(I32)len : (I32)len, G_DISCARD);
if(!HvARRAY(isarev) || !HvUSEDKEYS(isarev))
(void)hv_delete(PL_isarev, key,
HeKUTF8(iter) ? -klen : klen, G_DISCARD);
else sv_catpvs(namesv, "::");
}
if (GvNAMELEN(gv) != 1) {
- sv_catpvn(namesv, GvNAME(gv), GvNAMELEN(gv) - 2);
+ sv_catpvn_flags(
+ namesv, GvNAME(gv), GvNAMELEN(gv) - 2,
/* skip trailing :: */
- if ( GvNAMEUTF8(gv) )
- SvUTF8_on(namesv);
+ GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES
+ );
}
}
else {
else sv_catpvs(aname, "::");
}
if (GvNAMELEN(gv) != 1) {
- sv_catpvn(aname, GvNAME(gv), GvNAMELEN(gv) - 2);
+ sv_catpvn_flags(
+ aname, GvNAME(gv), GvNAMELEN(gv) - 2,
/* skip trailing :: */
- if ( GvNAMEUTF8(gv) )
- SvUTF8_on(aname);
+ GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES
+ );
}
av_push((AV *)namesv, aname);
}
STRLEN len;
const char *name = SvPVx_const(*svp++, len);
if(PL_stashcache)
- (void)hv_delete(PL_stashcache, name, name_utf8 ? -len : len, G_DISCARD);
+ (void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD);
hv_ename_delete(oldstash, name, len, name_utf8);
if (!fetched_isarev) {
if(meta->isa && HvARRAY(meta->isa))
mro_clean_isarev(meta->isa, name, len, 0, name_utf8);
isarev = (HV *)hv_delete(PL_isarev, name,
- name_utf8 ? -len : len, 0);
+ name_utf8 ? -(I32)len : (I32)len, 0);
fetched_isarev=TRUE;
}
}
/* 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) ? -len : len, 0) : NULL;
+ = stash ? hv_fetch(stash, key, HeUTF8(entry) ? -(I32)len : (I32)len, 0) : NULL;
HV *substash = NULL;
/* Avoid main::main::main::... */
sv_catpvs(aname, ":");
else {
sv_catpvs(aname, "::");
- sv_catpvn(aname, key, len-2);
- if ( SvUTF8(keysv) )
- SvUTF8_on(aname);
+ sv_catpvn_flags(
+ aname, key, len-2,
+ HeUTF8(entry)
+ ? SV_CATUTF8 : SV_CATBYTES
+ );
}
av_push((AV *)subname, aname);
}
if (len == 1) sv_catpvs(subname, ":");
else {
sv_catpvs(subname, "::");
- sv_catpvn(subname, key, len-2);
- if ( SvUTF8(keysv) )
- SvUTF8_on(subname);
+ sv_catpvn_flags(
+ subname, key, len-2,
+ HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES
+ );
}
}
mro_gather_and_rename(
);
}
- (void)hv_store(seen, key, SvUTF8(keysv) ? -len : len, &PL_sv_yes, 0);
+ (void)hv_store(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len, &PL_sv_yes, 0);
}
}
}
/* 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) ? -len : 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. */
sv_catpvs(aname, ":");
else {
sv_catpvs(aname, "::");
- sv_catpvn(aname, key, len-2);
- if ( SvUTF8(keysv) )
- SvUTF8_on(aname);
+ sv_catpvn_flags(
+ aname, key, len-2,
+ HeUTF8(entry)
+ ? SV_CATUTF8 : SV_CATBYTES
+ );
}
av_push((AV *)subname, aname);
}
if (len == 1) sv_catpvs(subname, ":");
else {
sv_catpvs(subname, "::");
- sv_catpvn(subname, key, len-2);
- if ( SvUTF8(keysv) )
- SvUTF8_on(subname);
+ sv_catpvn_flags(
+ subname, key, len-2,
+ HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES
+ );
}
}
mro_gather_and_rename(
const bool stashname_utf8 = HvENAMEUTF8(stash) ? 1 : 0;
SV ** const svp = hv_fetch(PL_isarev, stashname,
- stashname_utf8 ? -stashname_len : stashname_len, 0);
+ stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, 0);
HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
https://perl5.git.perl.org / perl5.git / blobdiff