t/mro/recursion_c3_utf8.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5 BEGIN {
   6     unless (-d 'blib') {
   7         chdir 't' if -d 't';
   8         @INC = '../lib';
   9     }
  10 }
  11 use utf8;
  12 use open qw( :utf8 :std );
  13
  14 require './test.pl';
  15
  16 plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
  17 plan(tests => 8);
  18
  19 require mro;
  20
  21 =pod
  22
  23 These are like the 010_complex_merge_classless test,
  24 but an infinite loop has been made in the heirarchy,
  25 to test that we can fail cleanly instead of going
  26 into 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
  69 my @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
  80 foreach 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 }