Fix {%hash} ~~ %hash test

[p5sagit/p5-mst-13.2.git] / t / mro / basic.t

diff --git a/t/mro/basic.t b/t/mro/basic.t
index a4a6192..e066226 100644 (file)
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,9 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 35);
+require q(./test.pl); plan(tests => 40);
+
+require mro;
 
 {
     package MRO_A;
@@ -173,6 +175,19 @@ is(eval { MRO_N->testfunc() }, 123);
 
     ok(eq_array(mro::get_linear_isa('ISACLEAR1'),[qw/ISACLEAR1/]));
     ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2/]));
+
+    # [perl #49564]  This is a pretty obscure way of clearing @ISA but
+    # it tests a regression that affects XS code calling av_clear too.
+    {
+        package ISACLEAR3;
+        our @ISA = qw/WW XX/;
+    }
+    ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3 WW XX/]));
+    {
+        package ISACLEAR3;
+        reset 'I';
+    }
+    ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3/]));
 }
 
 # Check that recursion bails out "cleanly" in a variety of cases
@@ -190,3 +205,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);
+}
+