Test that extending oneself actually throws an error

diff --git a/t/303_RT_39001_fix.t b/t/303_RT_39001_fix.t
new file mode 100644 (file)
index 0000000..a185ef2
--- /dev/null
+++ b/t/303_RT_39001_fix.t
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Class::MOP');
+}
+
+=pod
+
+This tests a bug sent via RT #39001
+
+=cut
+
+{
+    package Foo;
+    use metaclass;
+}
+
+throws_ok {
+    Foo->meta->superclasses('Foo');
+} qr/^Recursive inheritance detected/, "error occurs when extending oneself";
+
+{
+    package Bar;
+    use metaclass;
+}
+
+lives_ok {
+    Foo->meta->superclasses('Bar');
+} "regular subclass";
+
+throws_ok {
+    Bar->meta->superclasses('Foo');
+} qr/^Recursive inheritance detected/, "error occurs when Bar extends Foo, when Foo is a Bar";
+