diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | mro.c | 50 | ||||
| -rw-r--r-- | proto.h | 6 |
4 files changed, 38 insertions, 21 deletions
@@ -2191,6 +2191,8 @@ Aop |SV* |mro_set_private_data|NN struct mro_meta *const smeta \ |NN SV *const data Aop |const struct mro_alg *|mro_get_from_name|NN SV *name Aop |void |mro_register |NN const struct mro_alg *mro +Aop |void |mro_set_mro |NN struct mro_meta *const meta \ + |NN SV *const name : Used in HvMROMETA(), which is public. Xpo |struct mro_meta* |mro_meta_init |NN HV* stash #if defined(USE_ITHREADS) diff --git a/global.sym b/global.sym index 2745823f96..5ec7ba3c4f 100644 --- a/global.sym +++ b/global.sym @@ -773,6 +773,7 @@ Perl_mro_get_private_data Perl_mro_set_private_data Perl_mro_get_from_name Perl_mro_register +Perl_mro_set_mro Perl_mro_meta_init Perl_mro_get_linear_isa Perl_mro_method_changed_in @@ -619,6 +619,34 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) } } +void +Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) +{ + const struct mro_alg *const which = Perl_mro_get_from_name(aTHX_ name); + + PERL_ARGS_ASSERT_MRO_SET_MRO; + + if (!which) + Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name); + + if(meta->mro_which != which) { + if (meta->mro_linear_c3 && !meta->mro_linear_dfs) { + /* If we were storing something directly, put it in the hash before + we lose it. */ + Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, + MUTABLE_SV(meta->mro_linear_c3)); + } + meta->mro_which = which; + /* Scrub our cached pointer to the private data. */ + meta->mro_linear_c3 = NULL; + /* Only affects local method cache, not + even child classes */ + meta->cache_gen++; + if(meta->mro_nextmethod) + hv_clear(meta->mro_nextmethod); + } +} + #include "XSUB.h" XS(XS_mro_get_linear_isa); @@ -688,7 +716,6 @@ XS(XS_mro_set_mro) dVAR; dXSARGS; SV* classname; - const struct mro_alg *which; HV* class_stash; struct mro_meta* meta; @@ -700,26 +727,7 @@ XS(XS_mro_set_mro) if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname)); meta = HvMROMETA(class_stash); - which = Perl_mro_get_from_name(aTHX_ ST(1)); - if (!which) - Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1)); - - if(meta->mro_which != which) { - if (meta->mro_linear_c3 && !meta->mro_linear_dfs) { - /* If we were storing something directly, put it in the hash before - we lose it. */ - Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, - MUTABLE_SV(meta->mro_linear_c3)); - } - meta->mro_which = which; - /* Scrub our cached pointer to the private data. */ - meta->mro_linear_c3 = NULL; - /* Only affects local method cache, not - even child classes */ - meta->cache_gen++; - if(meta->mro_nextmethod) - hv_clear(meta->mro_nextmethod); - } + Perl_mro_set_mro(aTHX_ meta, ST(1)); XSRETURN_EMPTY; } @@ -6577,6 +6577,12 @@ PERL_CALLCONV void Perl_mro_register(pTHX_ const struct mro_alg *mro) #define PERL_ARGS_ASSERT_MRO_REGISTER \ assert(mro) +PERL_CALLCONV void Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_MRO_SET_MRO \ + assert(meta); assert(name) + PERL_CALLCONV struct mro_meta* Perl_mro_meta_init(pTHX_ HV* stash) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_MRO_META_INIT \ |