From: Rick Delaney Date: Tue, 14 Aug 2007 01:45:17 +0000 (-0400) Subject: Test update to demonstrate @ISA assignment bug: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=915d8d752a158c0f94585cfaa3cbb0711006156f;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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/); + } } +