From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 29 Nov 2012 02:04:01 +0000 (-0800)
Subject: Clear method caches when unwinding local *foo=*method
X-Git-Tag: upstream/5.20.0~4646^2~2
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4e52a9b69e39f85d6a5d7ac598c61ff0b00f94ee;p=platform%2Fupstream%2Fperl.git

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
--- 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
--- 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/); },