Commit | Line | Data |
b82a232d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
e3b65d64 |
6 | use Test::More; |
7 | use Algorithm::C3; # we already did use_ok 10 times by now.. |
b82a232d |
8 | |
e3b65d64 |
9 | plan skip_all => "Your system has no SIGALRM" if !exists $SIG{ALRM}; |
0f7ef7b1 |
10 | plan tests => 8; |
b82a232d |
11 | |
12 | =pod |
13 | |
84514a72 |
14 | These are like the 010_complex_merge_classless test, |
cadd8759 |
15 | but an infinite loop has been made in the heirarchy, |
16 | to test that we can fail cleanly instead of going |
17 | into an infinite loop |
b82a232d |
18 | |
19 | =cut |
20 | |
84514a72 |
21 | my @loopies = ( |
22 | { #1 |
23 | k => [qw(j i)], |
24 | j => [qw(f)], |
25 | i => [qw(h f)], |
26 | h => [qw(g)], |
27 | g => [qw(d)], |
28 | f => [qw(e)], |
29 | e => [qw(f)], |
30 | d => [qw(a b c)], |
31 | c => [], |
32 | b => [], |
33 | a => [], |
34 | }, |
35 | { #2 |
36 | k => [qw(j i)], |
37 | j => [qw(f)], |
38 | i => [qw(h f)], |
39 | h => [qw(g)], |
40 | g => [qw(d)], |
41 | f => [qw(e)], |
42 | e => [qw(d)], |
43 | d => [qw(a b c)], |
44 | c => [qw(f)], |
45 | b => [], |
46 | a => [], |
47 | }, |
48 | { #3 |
49 | k => [qw(j i)], |
50 | j => [qw(f)], |
51 | i => [qw(h f)], |
52 | h => [qw(g)], |
53 | g => [qw(d)], |
54 | f => [qw(e)], |
55 | e => [qw(d)], |
56 | d => [qw(a b c)], |
57 | c => [], |
58 | b => [], |
59 | a => [qw(k)], |
60 | }, |
61 | { #4 |
62 | k => [qw(j i)], |
63 | j => [qw(f k)], |
64 | i => [qw(h f)], |
65 | h => [qw(g)], |
66 | g => [qw(d)], |
67 | f => [qw(e)], |
68 | e => [qw(d)], |
69 | d => [qw(a b c)], |
70 | c => [], |
71 | b => [], |
72 | a => [], |
73 | }, |
74 | { #5 |
75 | k => [qw(j i)], |
76 | j => [qw(f)], |
77 | i => [qw(h f)], |
78 | h => [qw(k g)], |
79 | g => [qw(d)], |
80 | f => [qw(e)], |
81 | e => [qw(d)], |
82 | d => [qw(a b c)], |
83 | c => [], |
84 | b => [], |
85 | a => [], |
86 | }, |
0f7ef7b1 |
87 | { #6 |
88 | k => [qw(j i)], |
89 | j => [qw(f)], |
90 | i => [qw(h f)], |
91 | h => [qw(g)], |
92 | g => [qw(d)], |
93 | f => [qw(e)], |
94 | e => [qw(d)], |
95 | d => [qw(a b c)], |
96 | c => [], |
97 | b => [qw(b)], |
98 | a => [], |
99 | }, |
100 | { #7 |
101 | k => [qw(k j i)], |
102 | j => [qw(f)], |
103 | i => [qw(h f)], |
104 | h => [qw(g)], |
105 | g => [qw(d)], |
106 | f => [qw(e)], |
107 | e => [qw(d)], |
108 | d => [qw(a b c)], |
109 | c => [], |
110 | b => [], |
111 | a => [], |
112 | }, |
113 | { #7 |
114 | k => [qw(j i)], |
115 | j => [qw(f)], |
116 | i => [qw(h f)], |
117 | h => [qw(g)], |
118 | g => [qw(d)], |
119 | f => [qw(e)], |
120 | e => [qw(d)], |
121 | d => [qw(a h b c)], |
122 | c => [], |
123 | b => [], |
124 | a => [], |
125 | }, |
84514a72 |
126 | ); |
b82a232d |
127 | |
84514a72 |
128 | foreach my $loopy (@loopies) { |
129 | eval { |
130 | local $SIG{ALRM} = sub { die "ALRMTimeout" }; |
131 | alarm(3); |
132 | Algorithm::C3::merge('k', sub { |
133 | return @{ $loopy->{ $_[0] } }; |
134 | }); |
135 | }; |
b82a232d |
136 | |
84514a72 |
137 | if(my $err = $@) { |
138 | if($err =~ /ALRMTimeout/) { |
139 | ok(0, "Loop terminated by SIGALRM"); |
140 | } |
141 | elsif($err =~ /Infinite loop detected/) { |
142 | ok(1, "Graceful exception thrown"); |
143 | } |
144 | else { |
145 | ok(0, "Unrecognized exception: $err"); |
146 | } |
cadd8759 |
147 | } |
148 | else { |
84514a72 |
149 | ok(0, "Infinite loop apparently succeeded???"); |
cadd8759 |
150 | } |
cadd8759 |
151 | } |