Tests for types into Moo and Moose

diff --git a/xt/moo-role-types.t b/xt/moo-role-types.t
new file mode 100644 (file)
index 0000000..9dbed24
--- /dev/null
+++ b/xt/moo-role-types.t
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+
+{
+    package TestClientClass;
+    use Moo;
+    use namespace::clean -except => 'meta';
+
+    sub consume {}
+}
+
+{
+    package TestBadClientClass;
+    use Moo;
+    use namespace::clean -except => 'meta';
+
+    sub not_consume {}
+}
+
+{
+    package TestRole;
+    use Moo::Role;
+    use Sub::Quote;
+    use namespace::clean -except => 'meta';
+
+
+    has output_to => (
+        isa => quote_sub(q{
+            use Scalar::Util qw/ blessed /;
+            die $_[0] . "Does not have a ->consume method" unless blessed($_[0]) && $_[0]->can('consume'); }),
+        is => 'ro',
+        required => 1,
+        coerce => quote_sub(q{
+            my %stuff = %{$_[0]};
+            my $class = delete($stuff{class});
+            $class->new(%stuff);
+        }),
+    );
+}
+
+{
+    package TestMooClass;
+    use Moo;
+
+    with 'TestRole';
+}
+
+{
+    package TestMooseClass;
+    use Moose;
+
+    with 'TestRole';
+}
+
+foreach my $name (qw/ TestMooClass TestMooseClass /) {
+    my $i = $name->new(output_to => TestClientClass->new());
+    ok $i->output_to->can('consume');
+    $i = $name->new(output_to => { class => 'TestClientClass' });
+    ok $i->output_to->can('consume');
+};
+
+foreach my $name (qw/ TestMooClass TestMooseClass /) {
+    ok !exception { TestBadClientClass->new };
+    ok exception { $name->new(output_to => TestBadClientClass->new()) };
+    ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) };
+}
+
+done_testing;
+