1#!./perl 2 3use strict; 4use warnings; 5BEGIN { 6 unless (-d 'blib') { 7 chdir 't' if -d 't'; 8 @INC = '../lib'; 9 } 10} 11 12require './test.pl'; 13 14plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM}; 15plan(tests => 8); 16 17=pod 18 19These are like the 010_complex_merge_classless test, 20but an infinite loop has been made in the heirarchy, 21to test that we can fail cleanly instead of going 22into an infinite loop 23 24=cut 25 26# initial setup, everything sane 27{ 28 package K; 29 our @ISA = qw/J I/; 30 package J; 31 our @ISA = qw/F/; 32 package I; 33 our @ISA = qw/H F/; 34 package H; 35 our @ISA = qw/G/; 36 package G; 37 our @ISA = qw/D/; 38 package F; 39 our @ISA = qw/E/; 40 package E; 41 our @ISA = qw/D/; 42 package D; 43 our @ISA = qw/A B C/; 44 package C; 45 our @ISA = qw//; 46 package B; 47 our @ISA = qw//; 48 package A; 49 our @ISA = qw//; 50} 51 52# A series of 8 aberations that would cause infinite loops, 53# each one undoing the work of the previous 54my @loopies = ( 55 sub { @E::ISA = qw/F/ }, 56 sub { @E::ISA = qw/D/; @C::ISA = qw/F/ }, 57 sub { @C::ISA = qw//; @A::ISA = qw/K/ }, 58 sub { @A::ISA = qw//; @J::ISA = qw/F K/ }, 59 sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ }, 60 sub { @H::ISA = qw/G/; @B::ISA = qw/B/ }, 61 sub { @B::ISA = qw//; @K::ISA = qw/K J I/ }, 62 sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ }, 63); 64 65foreach my $loopy (@loopies) { 66 eval { 67 local $SIG{ALRM} = sub { die "ALRMTimeout" }; 68 alarm(3); 69 $loopy->(); 70 mro::get_linear_isa('K', 'dfs'); 71 }; 72 73 if(my $err = $@) { 74 if($err =~ /ALRMTimeout/) { 75 ok(0, "Loop terminated by SIGALRM"); 76 } 77 elsif($err =~ /Recursive inheritance detected/) { 78 ok(1, "Graceful exception thrown"); 79 } 80 else { 81 ok(0, "Unrecognized exception: $err"); 82 } 83 } 84 else { 85 ok(0, "Infinite loop apparently succeeded???"); 86 } 87} 88