/*
=head1 MRO Functions
These functions are related to the method resolution order of perl classes
+Also see L<perlmroapi>.
=cut
*/
/*
=for apidoc mro_register
-Registers a custom mro plugin. See L<perlmroapi> for details.
+Registers a custom mro plugin. See L<perlmroapi> for details on this and other
+mro functions.
=cut
*/
newmeta->super = NULL;
+ /* clear the destructor cache */
+ newmeta->destroy = NULL;
+ newmeta->destroy_gen = 0;
+
return newmeta;
}
if (level > 100)
Perl_croak(aTHX_
- "Recursive inheritance detected in package '%"HEKf"'",
+ "Recursive inheritance detected in package '%" HEKf "'",
HEKfARG(stashhek));
meta = HvMROMETA(stash);
/* They have no stash. So create ourselves an ->isa cache
as if we'd copied it from what theirs should be. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
- (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
+ (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
av_push(retval,
newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
&PL_sv_undef, 0))));
} else {
/* We have no parents. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
- (void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
+ (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef);
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
HEK_LEN(canon_name), HEK_FLAGS(canon_name),
HV_FETCH_ISSTORE, &PL_sv_undef,
HEK_HASH(canon_name));
- (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
+ (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef);
SvREADONLY_on(isa_hash);
svp = hv_fetchhek(PL_isarev, stashhek, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
- if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
- || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
+ if((memEQs(stashname, stashname_len, "UNIVERSAL"))
+ || (isarev && hv_existss(isarev, "UNIVERSAL"))) {
PL_sub_generation++;
is_universal = TRUE;
}
/* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
- /* DESTROY can be cached in SvSTASH. */
- if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+ /* DESTROY can be cached in meta. */
+ meta->destroy_gen = 0;
/* Iterate the isarev (classes that are our children),
wiping out their linearization, method and isa caches
if (name_count < 0) ++namep, name_count = -name_count - 1;
}
if (name_count == 1) {
- if (HEK_LEN(*namep) == 4 && strnEQ(HEK_KEY(*namep), "main", 4)) {
+ if (memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")) {
namesv = GvNAMELEN(gv) == 1
? newSVpvs_flags(":", SVs_TEMP)
: newSVpvs_flags("", SVs_TEMP);
SV *aname;
namesv = sv_2mortal((SV *)newAV());
while (name_count--) {
- if(HEK_LEN(*namep) == 4 && strnEQ(HEK_KEY(*namep), "main", 4)){
+ if(memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")){
aname = GvNAMELEN(gv) == 1
? newSVpvs(":")
: newSVpvs("");
mro_isa_changed_in on each. */
hv_iterinit(stashes);
while((iter = hv_iternext(stashes))) {
- HV * const stash = *(HV **)HEK_KEY(HeKEY_hek(iter));
- if(HvENAME(stash)) {
+ HV * const this_stash = *(HV **)HEK_KEY(HeKEY_hek(iter));
+ if(HvENAME(this_stash)) {
/* We have to restore the original meta->isa (that
mro_gather_and_rename set aside for us) this way, in case
one class in this list is a superclass of a another class
that we have already encountered. In such a case, meta->isa
-
+ will have been overwritten without old entries being deleted
from PL_isarev. */
- struct mro_meta * const meta = HvMROMETA(stash);
+ struct mro_meta * const meta = HvMROMETA(this_stash);
if(meta->isa != (HV *)HeVAL(iter)){
SvREFCNT_dec(meta->isa);
meta->isa
: (HV *)HeVAL(iter);
HeVAL(iter) = NULL; /* We donated our reference count. */
}
- mro_isa_changed_in(stash);
+ mro_isa_changed_in(this_stash);
}
}
}
STRLEN len;
const char *name = SvPVx_const(*svp, len);
if(PL_stashcache) {
- DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%"SVf"'\n",
+ DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%" SVf "'\n",
SVfARG(*svp)));
(void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD);
}
/* Inc the package generation, since a local method changed */
HvMROMETA(stash)->pkg_gen++;
- /* DESTROY can be cached in SvSTASH. */
- if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
+ /* DESTROY can be cached in meta */
+ HvMROMETA(stash)->destroy_gen = 0;
/* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
invalidate all method caches globally */
- if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
- || (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
+ if((memEQs(stashname, stashname_len, "UNIVERSAL"))
+ || (isarev && hv_existss(isarev, "UNIVERSAL"))) {
PL_sub_generation++;
return;
}
mrometa->cache_gen++;
if(mrometa->mro_nextmethod)
hv_clear(mrometa->mro_nextmethod);
- if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
+ mrometa->destroy_gen = 0;
}
}
PERL_ARGS_ASSERT_MRO_SET_MRO;
if (!which)
- Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name);
+ Perl_croak(aTHX_ "Invalid mro name: '%" SVf "'", name);
if(meta->mro_which != which) {
if (meta->mro_linear_current && !meta->mro_linear_all) {
classname = ST(0);
class_stash = gv_stashsv(classname, 0);
- if(!class_stash) Perl_croak(aTHX_ "No such class: '%"SVf"'!", SVfARG(classname));
+ if(!class_stash) Perl_croak(aTHX_ "No such class: '%" SVf "'!", SVfARG(classname));
mro_method_changed_in(class_stash);