mro::method_changed_in(..) ignores AUTOLOAD (RT #60220)
authorTony Cook <tony@develop-help.com>
Sat, 18 Jul 2009 19:49:04 +0000 (14:49 -0500)
committerDavid Mitchell <davem@iabyn.com>
Sun, 19 Jul 2009 21:48:26 +0000 (22:48 +0100)
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>

(cherry picked from commit 26d68d86a346a9cd3eddb7ee18bfaa50db17b7f0)

sv.c
t/mro/basic.t

diff --git a/sv.c b/sv.c
index c79ac10..cde1f00 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3458,6 +3458,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr)
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
+    bool mro_changes = FALSE;
 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 
@@ -3484,6 +3485,8 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *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:
@@ -3560,6 +3563,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr)
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
+    if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));
     return;
 }
 
index e066226..8568517 100644 (file)
@@ -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");
+}