Commit | Line | Data |
5fa003bf |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
a133bcea |
4 | use Test::More tests => 46; |
5fa003bf |
5 | use Test::Exception; |
6 | |
315b97c2 |
7 | { |
8 | { |
a497c7d3 |
9 | package My::Role; |
10 | use Mouse::Role; |
11 | |
12 | package My::Class; |
13 | use Mouse; |
14 | |
15 | with 'My::Role'; |
16 | |
5fa003bf |
17 | package Foo; |
18 | use Mouse; |
19 | |
20 | has foo => ( |
21 | is => 'ro', |
22 | isa => 'HashRef[Int]', |
23 | ); |
315b97c2 |
24 | |
25 | has bar => ( |
26 | is => 'ro', |
27 | isa => 'ArrayRef[Int]', |
28 | ); |
29 | |
a497c7d3 |
30 | has complex => ( |
31 | is => 'rw', |
315b97c2 |
32 | isa => 'ArrayRef[HashRef[Int]]' |
33 | ); |
a497c7d3 |
34 | |
35 | has my_class => ( |
36 | is => 'rw', |
37 | isa => 'ArrayRef[My::Class]', |
38 | ); |
39 | |
40 | has my_role => ( |
41 | is => 'rw', |
42 | isa => 'ArrayRef[My::Role]', |
43 | ); |
5fa003bf |
44 | }; |
45 | |
46 | ok(Foo->meta->has_attribute('foo')); |
315b97c2 |
47 | |
48 | lives_and { |
49 | my $hash = { a => 1, b => 2, c => 3 }; |
50 | my $array = [ 1, 2, 3 ]; |
51 | my $complex = [ { a => 1, b => 1 }, { c => 2, d => 2} ]; |
52 | my $foo = Foo->new(foo => $hash, bar => $array, complex => $complex); |
53 | |
54 | is_deeply($foo->foo(), $hash, "foo is a proper hash"); |
55 | is_deeply($foo->bar(), $array, "bar is a proper array"); |
56 | is_deeply($foo->complex(), $complex, "complex is a proper ... structure"); |
a497c7d3 |
57 | |
58 | $foo->my_class([My::Class->new]); |
59 | is ref($foo->my_class), 'ARRAY'; |
60 | isa_ok $foo->my_class->[0], 'My::Class'; |
61 | |
62 | $foo->my_role([My::Class->new]); |
63 | is ref($foo->my_role), 'ARRAY'; |
64 | |
315b97c2 |
65 | } "Parameterized constraints work"; |
66 | |
67 | # check bad args |
68 | throws_ok { |
69 | Foo->new( foo => { a => 'b' }); |
70 | } qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'HashRef\[Int\]' failed with value/, "Bad args for hash throws an exception"; |
71 | |
72 | throws_ok { |
73 | Foo->new( bar => [ a => 'b' ]); |
74 | } qr/Attribute \(bar\) does not pass the type constraint because: Validation failed for 'ArrayRef\[Int\]' failed with value/, "Bad args for array throws an exception"; |
75 | |
76 | throws_ok { |
77 | Foo->new( complex => [ { a => 1, b => 1 }, { c => "d", e => "f" } ] ) |
78 | } qr/Attribute \(complex\) does not pass the type constraint because: Validation failed for 'ArrayRef\[HashRef\[Int\]\]' failed with value/, "Bad args for complex types throws an exception"; |
a497c7d3 |
79 | |
80 | throws_ok { |
81 | Foo->new( my_class => [ 10 ] ); |
82 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' failed with value/; |
83 | throws_ok { |
84 | Foo->new( my_class => [ {foo => 'bar'} ] ); |
85 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' failed with value/; |
86 | |
87 | |
88 | throws_ok { |
89 | Foo->new( my_role => [ 20 ] ); |
90 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' failed with value/; |
91 | throws_ok { |
92 | Foo->new( my_role => [ {foo => 'bar'} ] ); |
93 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' failed with value/; |
315b97c2 |
94 | } |
95 | |
310ad28b |
96 | { |
97 | { |
98 | package Bar; |
99 | use Mouse; |
100 | use Mouse::Util::TypeConstraints; |
a133bcea |
101 | |
310ad28b |
102 | subtype 'Bar::List' |
103 | => as 'ArrayRef[HashRef]' |
104 | ; |
105 | coerce 'Bar::List' |
106 | => from 'ArrayRef[Str]' |
107 | => via { |
108 | [ map { +{ $_ => 1 } } @$_ ] |
109 | } |
110 | ; |
111 | has 'list' => ( |
112 | is => 'ro', |
113 | isa => 'Bar::List', |
114 | coerce => 1, |
115 | ); |
116 | } |
117 | |
118 | lives_and { |
119 | my @list = ( {a => 1}, {b => 1}, {c => 1} ); |
120 | my $bar = Bar->new(list => [ qw(a b c) ]); |
121 | |
122 | is_deeply( $bar->list, \@list, "list is as expected"); |
123 | } "coercion works"; |
124 | |
125 | throws_ok { |
126 | Bar->new(list => [ { 1 => 2 }, 2, 3 ]); |
127 | } qr/Attribute \(list\) does not pass the type constraint because: Validation failed for 'Bar::List' failed with value/, "Bad coercion parameter throws an error"; |
128 | } |
129 | |
a133bcea |
130 | use Mouse::Util::TypeConstraints; |
131 | |
132 | my $t = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); |
133 | ok $t->is_a_type_of($t), "$t is a type of $t"; |
134 | ok $t->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
135 | |
136 | # XXX: how about 'MaybeInt[ Int ]'? |
137 | ok $t->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
138 | |
139 | ok!$t->is_a_type_of('Int'); |
140 | |
141 | ok $t->check(10); |
142 | ok $t->check(undef); |
143 | ok!$t->check(3.14); |
144 | |
145 | my $u = subtype 'MaybeInt', as 'Maybe[Int]'; |
146 | ok $u->is_a_type_of($t), "$t is a type of $t"; |
147 | ok $u->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
148 | |
149 | # XXX: how about 'MaybeInt[ Int ]'? |
150 | ok $u->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
151 | |
152 | ok!$u->is_a_type_of('Int'); |
153 | |
154 | ok $u->check(10); |
155 | ok $u->check(undef); |
156 | ok!$u->check(3.14); |
157 | |
158 | # XXX: undefined hehaviour |
159 | # ok $t->is_a_type_of($u); |
160 | # ok $u->is_a_type_of($t); |
161 | |
162 | my $w = subtype as 'Maybe[ ArrayRef | HashRef ]'; |
163 | |
164 | ok $w->check(undef); |
165 | ok $w->check([]); |
166 | ok $w->check({}); |
167 | ok!$w->check(sub{}); |
168 | |
169 | ok $w->is_a_type_of('Maybe'); |
170 | ok $w->is_a_type_of('Maybe[ArrayRef|HashRef]'); |
171 | ok!$w->is_a_type_of('ArrayRef'); |
172 | |
173 | my $x = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[ ArrayRef[ Int | Undef ] ]'); |
174 | |
175 | ok $x->is_a_type_of('ArrayRef'); |
176 | ok $x->is_a_type_of('ArrayRef[ArrayRef[Int|Undef]]'); |
177 | ok!$x->is_a_type_of('ArrayRef[ArrayRef[Str]]'); |
178 | |
179 | ok $x->check([]); |
180 | ok $x->check([[]]); |
181 | ok $x->check([[10]]); |
182 | ok $x->check([[10, undef]]); |
183 | ok!$x->check([[10, 3.14]]); |
184 | ok!$x->check({}); |
315b97c2 |
185 | |
5fa003bf |
186 | |