diff options
author | Rick Delaney <rick@consumercontact.com> | 2007-08-13 21:45:17 -0400 |
---|---|---|
committer | Abhijit Menon-Sen <ams@wiw.org> | 2007-08-15 10:05:31 +0000 |
commit | 915d8d752a158c0f94585cfaa3cbb0711006156f (patch) | |
tree | 11597df65ae2bb54b7fb9cada9ef6254a177defe /t/mro | |
parent | 758fcfc19a1a2c48f6e2b45a4c3c6ef17980ecb4 (diff) | |
download | perl-915d8d752a158c0f94585cfaa3cbb0711006156f.tar.gz |
Test update to demonstrate @ISA assignment bug:
Subject: Optimized magic_setisa has bug
Message-Id: <20070814054517.GA12709@bort.ca>
p4raw-id: //depot/perl@31719
Diffstat (limited to 't/mro')
-rw-r--r-- | t/mro/basic.t | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/t/mro/basic.t b/t/mro/basic.t index e6792751ee..f23fabed00 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/); + } } + |