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