t/303_RT_39001_fix.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More tests => 3;
   6 use Test::Exception;
   7
   8 use Class::MOP;
   9
  10 =pod
  11
  12 This tests a bug sent via RT #39001
  13
  14 =cut
  15
  16 {
  17     package Foo;
  18     use metaclass;
  19 }
  20
  21 throws_ok {
  22     Foo->meta->superclasses('Foo');
  23 } qr/^Recursive inheritance detected/, "error occurs when extending oneself";
  24
  25 {
  26     package Bar;
  27     use metaclass;
  28 }
  29
  30 lives_ok {
  31     Foo->meta->superclasses('Bar');
  32 } "regular subclass";
  33
  34 throws_ok {
  35     Bar->meta->superclasses('Foo');
  36 } qr/^Recursive inheritance detected/, "error occurs when Bar extends Foo, when Foo is a Bar";
  37