Tests for types into Moo and Moose
[gitmo/Moo.git] / xt / moo-role-types.t
CommitLineData
f37e26e8 1use strict;
2use warnings;
3use Test::More;
4use Test::Fatal;
5
6{
7 package TestClientClass;
8 use Moo;
9 use namespace::clean -except => 'meta';
10
11 sub consume {}
12}
13
14{
15 package TestBadClientClass;
16 use Moo;
17 use namespace::clean -except => 'meta';
18
19 sub not_consume {}
20}
21
22{
23 package TestRole;
24 use Moo::Role;
25 use Sub::Quote;
26 use namespace::clean -except => 'meta';
27
28
29 has output_to => (
30 isa => quote_sub(q{
31 use Scalar::Util qw/ blessed /;
32 die $_[0] . "Does not have a ->consume method" unless blessed($_[0]) && $_[0]->can('consume'); }),
33 is => 'ro',
34 required => 1,
35 coerce => quote_sub(q{
36 my %stuff = %{$_[0]};
37 my $class = delete($stuff{class});
38 $class->new(%stuff);
39 }),
40 );
41}
42
43{
44 package TestMooClass;
45 use Moo;
46
47 with 'TestRole';
48}
49
50{
51 package TestMooseClass;
52 use Moose;
53
54 with 'TestRole';
55}
56
57foreach my $name (qw/ TestMooClass TestMooseClass /) {
58 my $i = $name->new(output_to => TestClientClass->new());
59 ok $i->output_to->can('consume');
60 $i = $name->new(output_to => { class => 'TestClientClass' });
61 ok $i->output_to->can('consume');
62};
63
64foreach my $name (qw/ TestMooClass TestMooseClass /) {
65 ok !exception { TestBadClientClass->new };
66 ok exception { $name->new(output_to => TestBadClientClass->new()) };
67 ok exception { $name->new(output_to => { class => 'TestBadClientClass' }) };
68}
69
70done_testing;
71