From: Brandon Black <blblack@gmail.com>
Date: Mon, 8 Oct 2007 08:54:35 +0000 (-0500)
Subject: Re: [perl #46217] (resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2e7640f0c7a7d476b21bbcc8398038c0ecc98cd6;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #46217] (resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure)
From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60710080654s589f57eax90b7f78558ad8b6f@mail.gmail.com>

new tests.

p4raw-id: //depot/perl@32074
---

diff --git a/t/mro/basic.t b/t/mro/basic.t
index a4a6192..1b18661 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 => 35);
+require q(./test.pl); plan(tests => 38);
 
 {
     package MRO_A;
@@ -190,3 +190,31 @@ is(eval { MRO_N->testfunc() }, 123);
     }
 }
 
+# Check that SUPER caches get invalidated correctly
+{
+    {
+        package SUPERTEST;
+        sub new { bless {} => shift }
+        sub foo { $_[1]+1 }
+
+        package SUPERTEST::MID;
+        our @ISA = 'SUPERTEST';
+
+        package SUPERTEST::KID;
+        our @ISA = 'SUPERTEST::MID';
+        sub foo { my $s = shift; $s->SUPER::foo(@_) }
+
+        package SUPERTEST::REBASE;
+        sub foo { $_[1]+3 }
+    }
+
+    my $stk_obj = SUPERTEST::KID->new();
+    is($stk_obj->foo(1), 2);
+    { no warnings 'redefine';
+      *SUPERTEST::foo = sub { $_[1]+2 };
+    }
+    is($stk_obj->foo(2), 4);
+    @SUPERTEST::MID::ISA = 'SUPERTEST::REBASE';
+    is($stk_obj->foo(3), 6);
+}
+