From: Tony Cook <tony@develop-help.com>
Date: Sat, 18 Jul 2009 19:49:04 +0000 (-0500)
Subject: mro::method_changed_in(..) ignores AUTOLOAD (RT #60220)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26d68d86;p=p5sagit%2Fp5-mst-13.2.git

mro::method_changed_in(..) ignores AUTOLOAD (RT #60220)

Patch modified to use a boolean rather than an integer for tracking
mro changes in S_glob_assign_ref and test fixed not to warn.

URL: http://rt.perl.org/rt3/Ticket/Display.html?id=60220

From the bug report:

-----------------------------------------------------------------
When creating a subclass dynamically, and when adding
AUTOLOAD dynamically into the parent class, then that
AUTOLOAD is not seen in the method cache, even after
a call to "mro::method_changed_in('Parent')".

It only appears in the method cache after a call
to mro::invalidate_all_method_caches().

The attached test file demonstrates the problem.

This was detected while trying to solve bug 40159 in DBIx::DataModel.
-----------------------------------------------------------------

Message-ID: <20081031132021.GA21341@mars.tony.develop-help.com>
---

diff --git a/sv.c b/sv.c
index 5057f0d..b26bbef 100644
--- a/sv.c
+++ b/sv.c
@@ -3656,6 +3656,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
+    bool mro_changes = FALSE;
 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 
@@ -3676,6 +3677,8 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
 	goto common;
     case SVt_PVAV:
 	location = (SV **) &GvAV(dstr);
+        if (strEQ(GvNAME((GV*)dstr), "ISA"))
+	    mro_changes = TRUE;
 	import_flag = GVf_IMPORTED_AV;
 	goto common;
     case SVt_PVIO:
@@ -3754,6 +3757,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
 	SvTAINT(dstr);
+    if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
     return;
 }
 
diff --git a/t/mro/basic.t b/t/mro/basic.t
index e066226..8568517 100644
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 40);
+require q(./test.pl); plan(tests => 42);
 
 require mro;
 
@@ -233,3 +233,18 @@ is(eval { MRO_N->testfunc() }, 123);
     is($stk_obj->foo(3), 6);
 }
 
+{ 
+  {
+    # assigning @ISA via arrayref to globref RT 60220
+    package P1;
+    sub new { bless {}, shift }
+    
+    package P2;
+  }
+  *{P2::ISA} = [ 'P1' ];
+  my $foo = P2->new;
+  ok(!eval { $foo->bark }, "no bark method");
+  no warnings 'once';  # otherwise it'll bark about P1::bark used only once
+  *{P1::bark} = sub { "[bark]" };
+  is(scalar eval { $foo->bark }, "[bark]", "can bark now");
+}