summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2010-10-11 10:10:06 -0700
committerFather Chrysostomos <sprout@cpan.org>2010-10-11 10:10:06 -0700
commit6f86b615fa775fad6cc0c49f0615f38543ff5c19 (patch)
tree0e7d5f0d49cec273aac625aa606baf759f4d7a97
parent29912d932cee5589d4165d5eff62d0cc4f2c5195 (diff)
downloadperl-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.fnc3
-rw-r--r--embed.h2
-rw-r--r--hv.h1
-rw-r--r--mathoms.c7
-rw-r--r--mro.c53
-rw-r--r--proto.h7
6 files changed, 50 insertions, 23 deletions
diff --git a/embed.fnc b/embed.fnc
index d64b268345..b97452df65 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 f4d01f1922..6d15195c44 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 62646b3965..83f90d9a52 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 78516b3d4b..152a64c089 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 bd59465eb3..d8ef79c749 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 48d63608cd..9970d33e73 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 \