diff options
| -rw-r--r-- | scope.c | 17 | ||||
| -rw-r--r-- | scope.h | 1 | ||||
| -rw-r--r-- | sv.c | 26 | ||||
| -rw-r--r-- | t/mro/method_caching.t | 1 |
4 files changed, 43 insertions, 2 deletions
@@ -783,6 +783,23 @@ Perl_leave_scope(pTHX_ I32 base) SvREFCNT_dec(sv); SvREFCNT_dec(value); break; + case SAVEt_GVSLOT: /* any slot in GV */ + value = MUTABLE_SV(SSPOPPTR); + ptr = SSPOPPTR; + gv = MUTABLE_GV(SSPOPPTR); + hv = GvSTASH(gv); + if (hv && HvENAME(hv) && ( + (value && SvTYPE(value) == SVt_PVCV) + || (*(SV **)ptr && SvTYPE(*(SV**)ptr) == SVt_PVCV) + )) + { + if ((char *)ptr < (char *)GvGP(gv) + || (char *)ptr > (char *)GvGP(gv) + sizeof(struct gp) + || GvREFCNT(gv) > 1) + PL_sub_generation++; + else mro_method_changed_in(hv); + } + goto restore_svp; case SAVEt_AV: /* array reference */ av = MUTABLE_AV(SSPOPPTR); gv = MUTABLE_GV(SSPOPPTR); @@ -59,6 +59,7 @@ #define SAVEt_GVSV 49 #define SAVEt_FREECOPHH 50 #define SAVEt_CLEARPADRANGE 51 +#define SAVEt_GVSLOT 52 #define SAVEf_SETMAGIC 1 #define SAVEf_KEEPOLDELEM 2 @@ -3787,7 +3787,23 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr) GvCVGEN(dstr) = 0; /* Switch off cacheness. */ } } - SAVEGENERICSV(*location); + /* SAVEt_GVSLOT takes more room on the savestack and has more + overhead in leave_scope than SAVEt_GENERIC_SV. But for CVs + leave_scope needs access to the GV so it can reset method + caches. We must use SAVEt_GVSLOT whenever the type is + SVt_PVCV, even if the stash is anonymous, as the stash may + gain a name somehow before leave_scope. */ + if (stype == SVt_PVCV) { + /* There is no save_pushptrptrptr. Creating it for this + one call site would be overkill. So inline the ss push + routines here. */ + SSCHECK(4); + SSPUSHPTR(dstr); + SSPUSHPTR(location); + SSPUSHPTR(SvREFCNT_inc(*location)); + SSPUSHUV(SAVEt_GVSLOT); + } + else SAVEGENERICSV(*location); } dref = *location; if (stype == SVt_PVCV && (*location != sref || GvCVGEN(dstr))) { @@ -12610,6 +12626,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) ptr = POPPTR(ss,ix); TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */ break; + case SAVEt_GVSLOT: /* any slot in GV */ + sv = (const SV *)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv, param); + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */ + sv = (const SV *)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv, param); + break; case SAVEt_HV: /* hash reference */ case SAVEt_AV: /* array reference */ sv = (const SV *) POPPTR(ss,ix); diff --git a/t/mro/method_caching.t b/t/mro/method_caching.t index cbbd655f39..495e12fddc 100644 --- a/t/mro/method_caching.t +++ b/t/mro/method_caching.t @@ -37,7 +37,6 @@ my @testsubs = ( sub { is(MCTest::Derived->foo(0), 5); }, sub { { local *MCTest::Base::can = sub { "tomatoes" }; MCTest::Derived->can(0); } - local $::TODO = " "; is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa, 'removing method when unwinding local *method=sub{}'); }, sub { sub peas { "peas" } |