xref: /openbsd-src/gnu/usr.bin/perl/t/mro/recursion_c3_utf8.t (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b) 
1#!./perl
2
3use strict;
4use warnings;
5BEGIN {
6    unless (-d 'blib') {
7        chdir 't' if -d 't';
8    }
9    require './test.pl';
10    set_up_inc('../lib');
11}
12use utf8;
13use open qw( :utf8 :std );
14
15plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
16plan(tests => 8);
17
18require mro;
19
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 ƙ;
32    use mro 'c3';
33    our @ISA = qw/ᶨ ィ/;
34    package ᶨ;
35    use mro 'c3';
36    our @ISA = qw/ｆ/;
37    package ィ;
38    use mro 'c3';
39    our @ISA = qw/ʰ ｆ/;
40    package ʰ;
41    use mro 'c3';
42    our @ISA = qw/ᶢ/;
43    package ᶢ;
44    use mro 'c3';
45    our @ISA = qw/ᛞ/;
46    package ｆ;
47    use mro 'c3';
48    our @ISA = qw/ǝ/;
49    package ǝ;
50    use mro 'c3';
51    our @ISA = qw/ᛞ/;
52    package ᛞ;
53    use mro 'c3';
54    our @ISA = qw/Ạ Ｂ ʗ/;
55    package ʗ;
56    use mro 'c3';
57    our @ISA = qw//;
58    package Ｂ;
59    use mro 'c3';
60    our @ISA = qw//;
61    package Ạ;
62    use mro 'c3';
63    our @ISA = qw//;
64}
65
66# A series of 8 aberations that would cause infinite loops,
67#  each one undoing the work of the previous
68my @loopies = (
69    sub { @ǝ::ISA = qw/ｆ/ },
70    sub { @ǝ::ISA = qw/ᛞ/; @ʗ::ISA = qw/ｆ/ },
71    sub { @ʗ::ISA = qw//; @Ạ::ISA = qw/ƙ/ },
72    sub { @Ạ::ISA = qw//; @ᶨ::ISA = qw/ｆ ƙ/ },
73    sub { @ᶨ::ISA = qw/ｆ/; @ʰ::ISA = qw/ƙ ᶢ/ },
74    sub { @ʰ::ISA = qw/ᶢ/; @Ｂ::ISA = qw/Ｂ/ },
75    sub { @Ｂ::ISA = qw//; @ƙ::ISA = qw/ƙ ᶨ ィ/ },
76    sub { @ƙ::ISA = qw/ᶨ ィ/; @ᛞ::ISA = qw/Ạ ʰ Ｂ ʗ/ },
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('ƙ', '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}
102