diff options
| -rw-r--r-- | gv.h | 7 | ||||
| -rw-r--r-- | op.c | 6 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | t/mro/method_caching.t | 32 |
5 files changed, 44 insertions, 5 deletions
@@ -264,6 +264,13 @@ Return the CV from the GV. #define gv_autoload4(stash, name, len, method) \ gv_autoload_pvn(stash, name, len, !!(method)) #define newGVgen(pack) newGVgen_flags(pack, 0) +#define gv_method_changed(gv) \ + ( \ + assert_(isGV_with_GP(gv)) \ + GvREFCNT(gv) > 1 \ + ? (void)++PL_sub_generation \ + : mro_method_changed_in(GvSTASH(gv)) \ + ) #define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) #define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV) @@ -7548,7 +7548,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, GvCVGEN(gv) = 0; if (HvENAME_HEK(GvSTASH(gv))) /* sub Foo::bar { (shift)+1 } */ - mro_method_changed_in(GvSTASH(gv)); + gv_method_changed(gv); } } if (!CvGV(cv)) { @@ -7872,7 +7872,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, GvCV_set(gv,cv); GvCVGEN(gv) = 0; if (HvENAME_HEK(GvSTASH(gv))) - mro_method_changed_in(GvSTASH(gv)); /* newXS */ + gv_method_changed(gv); /* newXS */ } } if (!name) @@ -7906,7 +7906,7 @@ Perl_newSTUB(pTHX_ GV *gv, bool fake) GvCV_set(gv, cv); GvCVGEN(gv) = 0; if (!fake && HvENAME_HEK(GvSTASH(gv))) - mro_method_changed_in(GvSTASH(gv)); + gv_method_changed(gv); CvGV_set(cv, gv); CvFILE_set_from_cop(cv, PL_curcop); CvSTASH_set(cv, PL_curstash); @@ -861,7 +861,7 @@ Perl_leave_scope(pTHX_ I32 base) GvGP_set(gv, (GP*)ptr); /* putting a method back into circulation ("local")*/ if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvENAME_get(hv)) - mro_method_changed_in(hv); + gv_method_changed(gv); SvREFCNT_dec(gv); break; case SAVEt_FREESV: @@ -3823,7 +3823,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr) } GvCVGEN(dstr) = 0; /* Switch off cacheness. */ GvASSUMECV_on(dstr); - if(GvSTASH(dstr)) mro_method_changed_in(GvSTASH(dstr)); /* sub foo { 1 } sub bar { 2 } *bar = \&foo */ + if(GvSTASH(dstr)) gv_method_changed(dstr); /* sub foo { 1 } sub bar { 2 } *bar = \&foo */ } *location = SvREFCNT_inc_simple_NN(sref); if (import_flag && !(GvFLAGS(dstr) & import_flag) diff --git a/t/mro/method_caching.t b/t/mro/method_caching.t index 733193ae1b..d574cc9a22 100644 --- a/t/mro/method_caching.t +++ b/t/mro/method_caching.t @@ -1,6 +1,7 @@ #!./perl use strict; +no strict 'refs'; # we do a lot of this use warnings; no warnings 'redefine'; # we do a lot of this no warnings 'prototype'; # we do a lot of this @@ -57,6 +58,37 @@ my @testsubs = ( sub { *{MCTest::Base::} = *{Foo::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); }, sub { *MCTest::Derived::foo = \&MCTest::Base::foo; eval { MCTest::Derived::foo(0,0) }; ok(!$@); undef *MCTest::Derived::foo }, sub { eval 'package MCTest::Base; sub foo { $_[1]+18 }'; is(MCTest::Derived->foo(0), 18); }, + + # Redefining through a glob alias + sub { *A = *{'MCTest::Base::foo'}; eval 'sub A { $_[1]+19 }'; + is(MCTest::Derived->foo(0), 19, + 'redefining sub through glob alias via decl'); }, + sub { SKIP: { + skip_if_miniperl("no XS"); require XS::APItest; + *A = *{'MCTest::Base::foo'}; + XS::APItest::newCONSTSUB(\%main::, "A", 0, 20); + is (MCTest::Derived->foo(0), 20, + 'redefining sub through glob alias via newXS'); + } }, + sub { undef *{'MCTest::Base::foo'}; *A = *{'MCTest::Base::foo'}; + eval { no warnings 'once'; local *UNIVERSAL::foo = sub {96}; + MCTest::Derived->foo }; + ()=\&A; + eval { MCTest::Derived->foo }; + like($@, qr/Undefined subroutine/, + 'redefining sub through glob alias via stub vivification'); }, + sub { *A = *{'MCTest::Base::foo'}; + local *A = sub { 21 }; + is(MCTest::Derived->foo, 21, + 'redef sub through glob alias via local cv-to-glob assign'); }, + sub { *A = *{'MCTest::Base::foo'}; + eval 'sub MCTest::Base::foo { 22 }'; + { local *A = sub { 23 }; MCTest::Derived->foo } + is(MCTest::Derived->foo, 22, + 'redef sub through glob alias via localisation unwinding'); }, + sub { *A = *{'MCTest::Base::foo'}; *A = sub { 24 }; + is(MCTest::Derived->foo(0), 24, + 'redefining sub through glob alias via cv-to-glob assign'); }, ); plan(tests => scalar(@testsubs)); |