In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/6f86b615fa775fad6cc0c49f0615f38543ff5c19?hp=29912d932cee5589d4165d5eff62d0cc4f2c5195>
- Log ----------------------------------------------------------------- commit 6f86b615fa775fad6cc0c49f0615f38543ff5c19 Author: Father Chrysostomos <[email protected]> Date: Mon Oct 11 10:10:06 2010 -0700 Allow mro_isa_changed_in to be called on nonexistent packages This is necessary for an upcoming bug fix. (For this bug: @left::ISA = 'outer::inner'; @right::ISA = 'clone::inner'; *clone:: = \%outer::; print left->isa('clone::inner'),"\n"; print right->isa('outer::inner'),"\n"; ) This commit actually replaces mro_isa_changed_in with mro_isa_changed_in3. See the docs for it in the diff for mro.c. ----------------------------------------------------------------------- Summary of changes: embed.fnc | 3 ++- embed.h | 2 +- hv.h | 1 + mathoms.c | 7 +++++++ mro.c | 53 ++++++++++++++++++++++++++++++++++++----------------- proto.h | 7 +++---- 6 files changed, 50 insertions(+), 23 deletions(-) diff --git a/embed.fnc b/embed.fnc index d64b268..b97452d 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2362,7 +2362,8 @@ Apd |AV* |mro_get_linear_isa|NN HV* stash sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|U32 level #endif : Used in hv.c, mg.c, pp.c, sv.c -pd |void |mro_isa_changed_in|NN HV* stash +md |void |mro_isa_changed_in|NN HV* stash +pd |void |mro_isa_changed_in3|NULLOK HV* stash|NULLOK const char *stashname|STRLEN stashname_len Apd |void |mro_method_changed_in |NN HV* stash pdx |void |mro_package_moved |NN const HV *stash : Only used in perl.c diff --git a/embed.h b/embed.h index f4d01f1..6d15195 100644 --- a/embed.h +++ b/embed.h @@ -1049,7 +1049,7 @@ #define magic_wipepack(a,b) Perl_magic_wipepack(aTHX_ a,b) #define mg_localize(a,b,c) Perl_mg_localize(aTHX_ a,b,c) #define mode_from_discipline(a,b) Perl_mode_from_discipline(aTHX_ a,b) -#define mro_isa_changed_in(a) Perl_mro_isa_changed_in(aTHX_ a) +#define mro_isa_changed_in3(a,b,c) Perl_mro_isa_changed_in3(aTHX_ a,b,c) #define mro_package_moved(a) Perl_mro_package_moved(aTHX_ a) #define munge_qwlist_to_paren_list(a) Perl_munge_qwlist_to_paren_list(aTHX_ a) #define my_attrs(a,b) Perl_my_attrs(aTHX_ a,b) diff --git a/hv.h b/hv.h index 62646b3..83f90d9 100644 --- a/hv.h +++ b/hv.h @@ -67,6 +67,7 @@ struct mro_meta { (((smeta)->mro_which && (which) == (smeta)->mro_which) \ ? (smeta)->mro_linear_current \ : Perl_mro_get_private_data(aTHX_ (smeta), (which))) +#define mro_isa_changed_in(stash) mro_isa_changed_in3(stash, NULL, 0) /* Subject to change. Don't access this directly. diff --git a/mathoms.c b/mathoms.c index 78516b3..152a64c 100644 --- a/mathoms.c +++ b/mathoms.c @@ -83,6 +83,7 @@ PERL_CALLCONV I32 Perl_my_lstat(pTHX); PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2); PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp); PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv); +PERL_CALLCONV void Perl_mro_isa_changed_in(HV* stash); /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. @@ -1554,6 +1555,12 @@ Perl_sv_2bool(pTHX_ register SV *const sv) return sv_2bool_flags(sv, SV_GMAGIC); } +void +Perl_mro_isa_changed_in(pTHX_ HV* stash) +{ + return mro_isa_changed_in3(stash, NULL, 0); +} + #endif /* NO_MATHOMS */ /* diff --git a/mro.c b/mro.c index bd59465..d8ef79c 100644 --- a/mro.c +++ b/mro.c @@ -411,10 +411,22 @@ Takes the necessary steps (cache invalidations, mostly) when the @ISA of the given package has changed. Invoked by the C<setisa> magic, should not need to invoke directly. +=for apidoc mro_isa_changed_in3 + +Takes the necessary steps (cache invalidations, mostly) +when the @ISA of the given package has changed. Invoked +by the C<setisa> magic, should not need to invoke directly. + +The stash can be passed as the first argument, or its name and length as +the second and third (or both). If just the name is passed and the stash +does not exist, then only the subclasses' method and isa caches will be +invalidated. + =cut */ void -Perl_mro_isa_changed_in(pTHX_ HV* stash) +Perl_mro_isa_changed_in3(pTHX_ HV* stash, const char *stashname, + STRLEN stashname_len) { dVAR; HV* isarev; @@ -423,35 +435,39 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) SV** svp; I32 items; bool is_universal; - struct mro_meta * meta; - - const char * const stashname = HvNAME_get(stash); - const STRLEN stashname_len = HvNAMELEN_get(stash); + struct mro_meta * meta = NULL; - PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN; + if(!stashname && stash) { + stashname = HvNAME_get(stash); + stashname_len = HvNAMELEN_get(stash); + } + else if(!stash) + stash = gv_stashpvn(stashname, stashname_len, 0 /* don't add */); if(!stashname) Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table"); - /* wipe out the cached linearizations for this stash */ - meta = HvMROMETA(stash); - if (meta->mro_linear_all) { + if(stash) { + /* wipe out the cached linearizations for this stash */ + meta = HvMROMETA(stash); + if (meta->mro_linear_all) { SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all)); meta->mro_linear_all = NULL; /* This is just acting as a shortcut pointer. */ meta->mro_linear_current = NULL; - } else if (meta->mro_linear_current) { + } else if (meta->mro_linear_current) { /* Only the current MRO is stored, so this owns the data. */ SvREFCNT_dec(meta->mro_linear_current); meta->mro_linear_current = NULL; - } - if (meta->isa) { + } + if (meta->isa) { SvREFCNT_dec(meta->isa); meta->isa = NULL; - } + } - /* Inc the package generation, since our @ISA changed */ - meta->pkg_gen++; + /* Inc the package generation, since our @ISA changed */ + meta->pkg_gen++; + } /* Wipe the global method cache if this package is UNIVERSAL or one of its parents */ @@ -465,12 +481,12 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) is_universal = TRUE; } else { /* Wipe the local method cache otherwise */ - meta->cache_gen++; + if(meta) meta->cache_gen++; is_universal = FALSE; } /* wipe next::method cache too */ - if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod); + if(meta && meta->mro_nextmethod) hv_clear(meta->mro_nextmethod); /* Iterate the isarev (classes that are our children), wiping out their linearization, method and isa caches */ @@ -511,6 +527,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) 3) Add everything from our isarev to their isarev */ + /* This only applies if the stash exists. */ + if(!stash) return; + /* We're starting at the 2nd element, skipping ourselves here */ linear_mro = mro_get_linear_isa(stash); svp = AvARRAY(linear_mro) + 1; diff --git a/proto.h b/proto.h index 48d6360..9970d33 100644 --- a/proto.h +++ b/proto.h @@ -2244,11 +2244,10 @@ PERL_CALLCONV SV* Perl_mro_get_private_data(pTHX_ struct mro_meta *const smeta, #define PERL_ARGS_ASSERT_MRO_GET_PRIVATE_DATA \ assert(smeta); assert(which) -PERL_CALLCONV void Perl_mro_isa_changed_in(pTHX_ HV* stash) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN \ - assert(stash) +/* PERL_CALLCONV void mro_isa_changed_in(pTHX_ HV* stash) + __attribute__nonnull__(pTHX_1); */ +PERL_CALLCONV void Perl_mro_isa_changed_in3(pTHX_ HV* stash, const char *stashname, STRLEN stashname_len); PERL_CALLCONV struct mro_meta* Perl_mro_meta_init(pTHX_ HV* stash) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_MRO_META_INIT \ -- Perl5 Master Repository
