t/mro/recursion_c3.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
  12 require './test.pl';
  13
  14 plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
  15 plan(tests => 8);
  16
  17 =pod
  18
  19 These are like the 010_complex_merge_classless test,
  20 but an infinite loop has been made in the heirarchy,
  21 to test that we can fail cleanly instead of going
  22 into an infinite loop
  23
  24 =cut
  25
  26 # initial setup, everything sane
  27 {
  28     package K;
  29     use mro 'c3';
  30     our @ISA = qw/J I/;
  31     package J;
  32     use mro 'c3';
  33     our @ISA = qw/F/;
  34     package I;
  35     use mro 'c3';
  36     our @ISA = qw/H F/;
  37     package H;
  38     use mro 'c3';
  39     our @ISA = qw/G/;
  40     package G;
  41     use mro 'c3';
  42     our @ISA = qw/D/;
  43     package F;
  44     use mro 'c3';
  45     our @ISA = qw/E/;
  46     package E;
  47     use mro 'c3';
  48     our @ISA = qw/D/;
  49     package D;
  50     use mro 'c3';
  51     our @ISA = qw/A B C/;
  52     package C;
  53     use mro 'c3';
  54     our @ISA = qw//;
  55     package B;
  56     use mro 'c3';
  57     our @ISA = qw//;
  58     package A;
  59     use mro 'c3';
  60     our @ISA = qw//;
  61 }
  62
  63 # A series of 8 abberations that would cause infinite loops,
  64 #  each one undoing the work of the previous
  65 my @loopies = (
  66     sub { @E::ISA = qw/F/ },
  67     sub { @E::ISA = qw/D/; @C::ISA = qw/F/ },
  68     sub { @C::ISA = qw//; @A::ISA = qw/K/ },
  69     sub { @A::ISA = qw//; @J::ISA = qw/F K/ },
  70     sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ },
  71     sub { @H::ISA = qw/G/; @B::ISA = qw/B/ },
  72     sub { @B::ISA = qw//; @K::ISA = qw/K J I/ },
  73     sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ },
  74 );
  75
  76 foreach my $loopy (@loopies) {
  77     eval {
  78         local $SIG{ALRM} = sub { die "ALRMTimeout" };
  79         alarm(3);
  80         $loopy->();
  81         mro::get_linear_isa('K', 'c3');
  82     };
  83
  84     if(my $err = $@) {
  85         if($err =~ /ALRMTimeout/) {
  86             ok(0, "Loop terminated by SIGALRM");
  87         }
  88         elsif($err =~ /Recursive inheritance detected/) {
  89             ok(1, "Graceful exception thrown");
  90         }
  91         else {
  92             ok(0, "Unrecognized exception: $err");
  93         }
  94     }
  95     else {
  96         ok(0, "Infinite loop apparently succeeded???");
  97     }
  98 }