diff options
author | Father Chrysostomos <sprout@cpan.org> | 2010-10-11 10:10:06 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2010-10-11 10:10:06 -0700 |
commit | 6f86b615fa775fad6cc0c49f0615f38543ff5c19 (patch) | |
tree | 0e7d5f0d49cec273aac625aa606baf759f4d7a97 | |
parent | 29912d932cee5589d4165d5eff62d0cc4f2c5195 (diff) | |
download | perl-6f86b615fa775fad6cc0c49f0615f38543ff5c19.tar.gz |
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.
-rw-r--r-- | embed.fnc | 3 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | hv.h | 1 | ||||
-rw-r--r-- | mathoms.c | 7 | ||||
-rw-r--r-- | mro.c | 53 | ||||
-rw-r--r-- | proto.h | 7 |
6 files changed, 50 insertions, 23 deletions
@@ -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 @@ -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) @@ -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. @@ -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 */ /* @@ -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; @@ -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 \ |