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