1#!perl
2
3# XXX:
4# XXX: !!!Currently this test is not compatible with Moose!!!
5# XXX:
6
7use strict;
8use warnings;
9use Test::More tests => 22;
10
11{
12    package Foo;
13    use Mouse;
14    use Mouse::Util::TypeConstraints;
15    type Baz => where { defined($_) && $_ eq 'Baz' };
16
17    coerce Baz => from 'ArrayRef', via { 'Baz' };
18
19    has 'bar' => ( is => 'rw', isa => 'Str | Baz | Undef', coerce => 1 );
20}
21
22eval {
23    Foo->new( bar => +{} );
24};
25like($@, qr/^Attribute \(bar\) does not pass the type constraint because: Validation failed for 'Baz\|Str\|Undef' with value HASH\(\w+\)/, 'type constraint and coercion failed')
26    or diag "\$@='$@'";
27
28eval {
29    isa_ok(Foo->new( bar => undef ), 'Foo');
30};
31ok !$@, 'got an object 1';
32
33eval {
34    isa_ok(Foo->new( bar => 'foo' ), 'Foo');
35
36};
37ok !$@, 'got an object 2';
38
39
40my $f = Foo->new;
41eval {
42    $f->bar([]);
43};
44ok !$@, $@;
45is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)';
46
47eval {
48    $f->bar('hoge');
49};
50ok !$@;
51is $f->bar, 'hoge', 'bar is hoge';
52
53eval {
54    $f->bar(undef);
55};
56ok !$@;
57is $f->bar, undef, 'bar is undef';
58
59
60{
61    package Bar;
62    use Mouse;
63    use Mouse::Util::TypeConstraints;
64
65    type 'Type1' => where { defined($_) && $_ eq 'Name' };
66    coerce 'Type1', from 'Str', via { 'Names' };
67
68    type 'Type2' => where { defined($_) && $_ eq 'Group' };
69    coerce 'Type2', from 'Str', via { 'Name' };
70
71    has 'foo' => ( is => 'rw', isa => 'Type1|Type2', coerce => 1 );
72}
73
74my $foo = Bar->new( foo => 'aaa' );
75ok $foo, 'got an object 3';
76is $foo->foo, 'Name', 'foo is Name';
77
78
79{
80    package KLASS;
81    use Mouse;
82}
83{
84    package Funk;
85    use Mouse;
86    use Mouse::Util::TypeConstraints;
87
88    type 'Type3' => where { defined($_) && $_ eq 'Name' };
89    coerce 'Type3', from 'CodeRef', via { 'Name' };
90
91    has 'foo' => ( is => 'rw', isa => 'Type3|KLASS|Undef', coerce => 1 );
92}
93
94eval { Funk->new( foo => 'aaa' ) };
95like $@, qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'KLASS\|Type3\|Undef' with value aaa/;
96
97my $k = Funk->new;
98ok $k, 'got an object 4';
99$k->foo(sub {});
100is $k->foo, 'Name', 'foo is Name';
101$k->foo(KLASS->new);
102isa_ok $k->foo, 'KLASS';
103$k->foo(undef);
104is $k->foo, undef, 'foo is undef';
105
106# or-combination operator ('|')
107{
108    use Mouse::Util::TypeConstraints;
109    my $Int    = find_type_constraint 'Int';
110    my $Str    = find_type_constraint 'Str';
111    my $Object = find_type_constraint 'Object';
112
113    *t = \&Mouse::Util::TypeConstraints::find_or_parse_type_constraint; # alias
114
115    is $Int | $Str, t('Int | Str');
116    is $Str | $Int, t('Int | Str');
117
118    is $Int | $Str | $Object, t('Int | Str | Object');
119    is $Str | $Object | $Int, t('Int | Str | Object');
120}
121
122