Test update to demonstrate @ISA assignment bug:

Subject: Optimized magic_setisa has bug
Message-Id: <20070814054517.GA12709@bort.ca>

p4raw-id: //depot/perl@31719

diff --git a/t/mro/basic.t b/t/mro/basic.t
index e679275..f23fabe 100644 (file)
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 21);
+require q(./test.pl); plan(tests => 29);
 
 {
     package MRO_A;
@@ -146,4 +146,39 @@ is(eval { MRO_N->testfunc() }, 123);
     # undef the array itself
     undef @ISACLEAR::ISA;
     ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/]));
+
+    # Now, clear more than one package's @ISA at once
+    {
+        package ISACLEAR1;
+        our @ISA = qw/WW XX/;
+
+        package ISACLEAR2;
+        our @ISA = qw/YY ZZ/;
+    }
+    # baseline
+    ok(eq_array(mro::get_linear_isa('ISACLEAR1'),[qw/ISACLEAR1 WW XX/]));
+    ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2 YY ZZ/]));
+    (@ISACLEAR1::ISA, @ISACLEAR2::ISA) = ();
+
+    {
+        local our $TODO = 1;
+        ok(eq_array(mro::get_linear_isa('ISACLEAR1'),[qw/ISACLEAR1/]));
+    }
+    ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2/]));
+}
+
+# Check that recursion bails out "cleanly" in a variety of cases
+# (as opposed to say, bombing the interpreter or something)
+{
+    my @recurse_codes = (
+        '@MRO_R1::ISA = "MRO_R2"; @MRO_R2::ISA = "MRO_R1";',
+        '@MRO_R3::ISA = "MRO_R4"; push(@MRO_R4::ISA, "MRO_R3");',
+        '@MRO_R5::ISA = "MRO_R6"; @MRO_R6::ISA = qw/XX MRO_R5 YY/;',
+        '@MRO_R7::ISA = "MRO_R8"; push(@MRO_R8::ISA, qw/XX MRO_R7 YY/)',
+    );
+    foreach my $code (@recurse_codes) {
+        eval $code;
+        ok($@ =~ /Recursive inheritance detected/);
+    }
 }
+