t/303_RT_39001_fix.t

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