X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/abec5bedacd77b2152e61ec3216ab47bd7272fc9..7a65503b47db3b8dbe630d34b49208a49fc80c51:/mro_core.c diff --git a/mro_core.c b/mro_core.c index 25d30d9..d1abc28 100644 --- a/mro_core.c +++ b/mro_core.c @@ -191,6 +191,10 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) newmeta->super = NULL; + /* clear the destructor cache */ + newmeta->destroy = NULL; + newmeta->destroy_gen = 0; + return newmeta; } @@ -199,7 +203,7 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) /* =for apidoc mro_get_linear_isa_dfs -Returns the Depth-First Search linearization of @ISA +Returns the Depth-First Search linearization of C<@ISA> the given stash. The return value is a read-only AV*. C should be 0 (it is used internally in this function's recursion). @@ -237,7 +241,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) if (level > 100) Perl_croak(aTHX_ - "Recursive inheritance detected in package '%"HEKf"'", + "Recursive inheritance detected in package '%" HEKf "'", HEKfARG(stashhek)); meta = HvMROMETA(stash); @@ -342,7 +346,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) /* 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)))); @@ -352,7 +356,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) } 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); @@ -447,7 +451,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) 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); @@ -461,7 +465,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) =for apidoc mro_isa_changed_in Takes the necessary steps (cache invalidations, mostly) -when the @ISA of the given package has changed. Invoked +when the C<@ISA> of the given package has changed. Invoked by the C magic, should not need to invoke directly. =cut @@ -520,8 +524,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) 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; } @@ -538,8 +542,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* 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 @@ -950,7 +954,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, 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); } @@ -1295,7 +1299,7 @@ XS code. 2) Assigning a reference to a readonly scalar constant into a stash entry in order to create -a constant subroutine (like constant.pm +a constant subroutine (like F does). This same method is available from pure perl @@ -1320,13 +1324,13 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* 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; } @@ -1346,7 +1350,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) mrometa->cache_gen++; if(mrometa->mro_nextmethod) hv_clear(mrometa->mro_nextmethod); - if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; + mrometa->destroy_gen = 0; } } @@ -1365,7 +1369,7 @@ Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) 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) { @@ -1411,7 +1415,7 @@ XS(XS_mro_method_changed_in) 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);