Import tc tests

[gitmo/Mouse.git] / t / 040_type_constraints / failing / 031_subtype_auto_vivify_parent.t

diff --git a/t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t b/t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t
new file mode 100644 (file)
index 0000000..e245ab8
--- /dev/null
+++ b/t/040_type_constraints/failing/031_subtype_auto_vivify_parent.t
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Mouse::Util::TypeConstraints;
+
+
+{
+    package Foo;
+
+    sub new {
+        my $class = shift;
+
+        return bless {@_}, $class;
+    }
+}
+
+subtype 'FooWithSize'
+    => as 'Foo'
+    => where { $_[0]->{size} };
+
+
+my $type = find_type_constraint('FooWithSize');
+ok( $type,         'made a FooWithSize constraint' );
+ok( $type->parent, 'type has a parent type' );
+is( $type->parent->name, 'Foo', 'parent type is Foo' );
+isa_ok( $type->parent, 'Mouse::Meta::TypeConstraint::Class',
+        'parent type constraint is a class type' );