Commit | Line | Data |
eec1bb49 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More tests => 18; |
4 | |
5 | { |
6 | package Foo; |
7 | use Mouse; |
3b46bd49 |
8 | use Mouse::Util::TypeConstraints; |
3fa6f35d |
9 | type Baz => where { defined($_) && $_ eq 'Baz' }; |
a09601ab |
10 | |
eec1bb49 |
11 | coerce Baz => from 'ArrayRef', via { 'Baz' }; |
a09601ab |
12 | |
eec1bb49 |
13 | has 'bar' => ( is => 'rw', isa => 'Str | Baz | Undef', coerce => 1 ); |
14 | } |
15 | |
16 | eval { |
17 | Foo->new( bar => +{} ); |
18 | }; |
92583b33 |
19 | like($@, qr/^Attribute \(bar\) does not pass the type constraint because: Validation failed for 'Baz\|Str\|Undef' failed with value HASH\(\w+\)/, 'type constraint and coercion failed') |
a09601ab |
20 | or diag "\$@='$@'"; |
eec1bb49 |
21 | |
22 | eval { |
23 | isa_ok(Foo->new( bar => undef ), 'Foo'); |
24 | }; |
25 | ok !$@, 'got an object 1'; |
26 | |
27 | eval { |
28 | isa_ok(Foo->new( bar => 'foo' ), 'Foo'); |
29 | |
30 | }; |
31 | ok !$@, 'got an object 2'; |
32 | |
33 | |
34 | my $f = Foo->new; |
35 | eval { |
36 | $f->bar([]); |
37 | }; |
684db121 |
38 | ok !$@, $@; |
eec1bb49 |
39 | is $f->bar, 'Baz', 'bar is baz (coerce from ArrayRef)'; |
40 | |
41 | eval { |
42 | $f->bar('hoge'); |
43 | }; |
44 | ok !$@; |
45 | is $f->bar, 'hoge', 'bar is hoge'; |
46 | |
47 | eval { |
48 | $f->bar(undef); |
49 | }; |
50 | ok !$@; |
51 | is $f->bar, undef, 'bar is undef'; |
52 | |
53 | |
54 | { |
55 | package Bar; |
56 | use Mouse; |
3b46bd49 |
57 | use Mouse::Util::TypeConstraints; |
eec1bb49 |
58 | |
3fa6f35d |
59 | type 'Type1' => where { defined($_) && $_ eq 'Name' }; |
eec1bb49 |
60 | coerce 'Type1', from 'Str', via { 'Names' }; |
61 | |
3fa6f35d |
62 | type 'Type2' => where { defined($_) && $_ eq 'Group' }; |
eec1bb49 |
63 | coerce 'Type2', from 'Str', via { 'Name' }; |
64 | |
65 | has 'foo' => ( is => 'rw', isa => 'Type1|Type2', coerce => 1 ); |
66 | } |
67 | |
68 | my $foo = Bar->new( foo => 'aaa' ); |
69 | ok $foo, 'got an object 3'; |
70 | is $foo->foo, 'Name', 'foo is Name'; |
71 | |
72 | |
73 | { |
74 | package KLASS; |
a09601ab |
75 | use Mouse; |
eec1bb49 |
76 | } |
77 | { |
bcc5080b |
78 | package Funk; |
eec1bb49 |
79 | use Mouse; |
3b46bd49 |
80 | use Mouse::Util::TypeConstraints; |
eec1bb49 |
81 | |
3fa6f35d |
82 | type 'Type3' => where { defined($_) && $_ eq 'Name' }; |
eec1bb49 |
83 | coerce 'Type3', from 'CodeRef', via { 'Name' }; |
84 | |
85 | has 'foo' => ( is => 'rw', isa => 'Type3|KLASS|Undef', coerce => 1 ); |
86 | } |
87 | |
bcc5080b |
88 | eval { Funk->new( foo => 'aaa' ) }; |
92583b33 |
89 | like $@, qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'KLASS\|Type3\|Undef' failed with value aaa/; |
eec1bb49 |
90 | |
bcc5080b |
91 | my $k = Funk->new; |
eec1bb49 |
92 | ok $k, 'got an object 4'; |
93 | $k->foo(sub {}); |
94 | is $k->foo, 'Name', 'foo is Name'; |
95 | $k->foo(KLASS->new); |
96 | isa_ok $k->foo, 'KLASS'; |
97 | $k->foo(undef); |
98 | is $k->foo, undef, 'foo is undef'; |
99 | |