Clear method caches when unwinding local *foo=*method

It was already working for those cases where *foo contained a sub
before and after localisation.  For those cases where *foo had no sub
but localised assignment gave it one, method caches were not being
reset on scope exit.

case SAVEt_GP in scope.c:leave_scope needs to look at both GPs (glob
pointer, or list of glob slots), both from before and after the unlo-
calisation.  If either has a sub, method caches need to be cleared.

This does not yet fix local *foo = sub {}, but I added a to-do
test for it.  (This is more complicated, as localisation happens in
two seperate steps, the glob slot localisation storing no pointers to
the glob itself on the savestack.)

diff --git a/scope.c b/scope.c
index 31b990d..f96aa45 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -865,14 +865,18 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_GP:                          /* scalar reference */
            ptr = SSPOPPTR;
            gv = MUTABLE_GV(SSPOPPTR);
-           gp_free(gv);
-           GvGP_set(gv, (GP*)ptr);
-           if ((hv=GvSTASH(gv)) && HvENAME_get(hv)) {
+           {
+             /* possibly taking a method out of circulation */ 
+            const bool had_method = !!GvCVu(gv);
+            gp_free(gv);
+            GvGP_set(gv, (GP*)ptr);
+            if ((hv=GvSTASH(gv)) && HvENAME_get(hv)) {
              if (GvNAMELEN(gv) == 3 && strnEQ(GvNAME(gv), "ISA", 3))
                mro_isa_changed_in(hv);
-             else if (GvCVu(gv))
+             else if (had_method || GvCVu(gv))
                 /* putting a method back into circulation ("local")*/  
                 gv_method_changed(gv);
+            }
            }
            SvREFCNT_dec(gv);
            break;

diff --git a/t/mro/method_caching.t b/t/mro/method_caching.t
index d574cc9..d691926 100644 (file)
--- a/t/mro/method_caching.t
+++ b/t/mro/method_caching.t
@@ -36,6 +36,16 @@ my @testsubs = (
     sub { is(MCTest::Derived->foo(0), 5); },
     sub { sub FFF { $_[1]+7 }; local *MCTest::Base::foo = *FFF; is(MCTest::Derived->foo(0), 7); },
     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" }
+          { local *MCTest::Base::can = *peas;
+            MCTest::Derived->can(0); }
+          is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa,
+              'removing method when unwinding local *method=*other'); },
     sub { sub DDD { $_[1]+8 }; *MCTest::Base::foo = *DDD; is(MCTest::Derived->foo(0), 8); },
     sub { *ASDF::asdf = sub { $_[1]+9 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); },
     sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },