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