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