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