Commit | Line | Data |
eed39dff |
1 | #!perl |
5fa003bf |
2 | use strict; |
3 | use warnings; |
eed39dff |
4 | use Test::More; |
5fa003bf |
5 | use Test::Exception; |
6 | |
24dd8fef |
7 | use Tie::Hash; |
8 | use Tie::Array; |
315b97c2 |
9 | { |
10 | { |
a497c7d3 |
11 | package My::Role; |
12 | use Mouse::Role; |
13 | |
14 | package My::Class; |
15 | use Mouse; |
16 | |
17 | with 'My::Role'; |
18 | |
5fa003bf |
19 | package Foo; |
20 | use Mouse; |
21 | |
22 | has foo => ( |
23 | is => 'ro', |
24 | isa => 'HashRef[Int]', |
25 | ); |
315b97c2 |
26 | |
27 | has bar => ( |
28 | is => 'ro', |
29 | isa => 'ArrayRef[Int]', |
30 | ); |
31 | |
a497c7d3 |
32 | has complex => ( |
33 | is => 'rw', |
315b97c2 |
34 | isa => 'ArrayRef[HashRef[Int]]' |
35 | ); |
a497c7d3 |
36 | |
37 | has my_class => ( |
38 | is => 'rw', |
39 | isa => 'ArrayRef[My::Class]', |
40 | ); |
41 | |
42 | has my_role => ( |
43 | is => 'rw', |
44 | isa => 'ArrayRef[My::Role]', |
45 | ); |
5fa003bf |
46 | }; |
47 | |
48 | ok(Foo->meta->has_attribute('foo')); |
315b97c2 |
49 | |
50 | lives_and { |
51 | my $hash = { a => 1, b => 2, c => 3 }; |
52 | my $array = [ 1, 2, 3 ]; |
53 | my $complex = [ { a => 1, b => 1 }, { c => 2, d => 2} ]; |
54 | my $foo = Foo->new(foo => $hash, bar => $array, complex => $complex); |
55 | |
56 | is_deeply($foo->foo(), $hash, "foo is a proper hash"); |
57 | is_deeply($foo->bar(), $array, "bar is a proper array"); |
58 | is_deeply($foo->complex(), $complex, "complex is a proper ... structure"); |
a497c7d3 |
59 | |
60 | $foo->my_class([My::Class->new]); |
61 | is ref($foo->my_class), 'ARRAY'; |
62 | isa_ok $foo->my_class->[0], 'My::Class'; |
63 | |
64 | $foo->my_role([My::Class->new]); |
65 | is ref($foo->my_role), 'ARRAY'; |
66 | |
315b97c2 |
67 | } "Parameterized constraints work"; |
68 | |
69 | # check bad args |
70 | throws_ok { |
71 | Foo->new( foo => { a => 'b' }); |
537873b0 |
72 | } qr/Attribute \(foo\) does not pass the type constraint because: Validation failed for 'HashRef\[Int\]' with value/, "Bad args for hash throws an exception"; |
315b97c2 |
73 | |
74 | throws_ok { |
75 | Foo->new( bar => [ a => 'b' ]); |
537873b0 |
76 | } qr/Attribute \(bar\) does not pass the type constraint because: Validation failed for 'ArrayRef\[Int\]' with value/, "Bad args for array throws an exception"; |
315b97c2 |
77 | |
78 | throws_ok { |
79 | Foo->new( complex => [ { a => 1, b => 1 }, { c => "d", e => "f" } ] ) |
537873b0 |
80 | } qr/Attribute \(complex\) does not pass the type constraint because: Validation failed for 'ArrayRef\[HashRef\[Int\]\]' with value/, "Bad args for complex types throws an exception"; |
a497c7d3 |
81 | |
82 | throws_ok { |
83 | Foo->new( my_class => [ 10 ] ); |
537873b0 |
84 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' with value/; |
a497c7d3 |
85 | throws_ok { |
86 | Foo->new( my_class => [ {foo => 'bar'} ] ); |
537873b0 |
87 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' with value/; |
a497c7d3 |
88 | |
89 | |
90 | throws_ok { |
91 | Foo->new( my_role => [ 20 ] ); |
537873b0 |
92 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' with value/; |
a497c7d3 |
93 | throws_ok { |
94 | Foo->new( my_role => [ {foo => 'bar'} ] ); |
537873b0 |
95 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' with value/; |
315b97c2 |
96 | } |
97 | |
310ad28b |
98 | { |
99 | { |
100 | package Bar; |
101 | use Mouse; |
102 | use Mouse::Util::TypeConstraints; |
a133bcea |
103 | |
310ad28b |
104 | subtype 'Bar::List' |
105 | => as 'ArrayRef[HashRef]' |
106 | ; |
107 | coerce 'Bar::List' |
108 | => from 'ArrayRef[Str]' |
109 | => via { |
110 | [ map { +{ $_ => 1 } } @$_ ] |
111 | } |
112 | ; |
113 | has 'list' => ( |
114 | is => 'ro', |
115 | isa => 'Bar::List', |
116 | coerce => 1, |
117 | ); |
118 | } |
119 | |
120 | lives_and { |
121 | my @list = ( {a => 1}, {b => 1}, {c => 1} ); |
122 | my $bar = Bar->new(list => [ qw(a b c) ]); |
123 | |
124 | is_deeply( $bar->list, \@list, "list is as expected"); |
568f88f2 |
125 | } "coercion works" |
126 | or diag( Mouse::Util::TypeConstraints::find_type_constraint("Bar::List")->dump ); |
310ad28b |
127 | |
128 | throws_ok { |
129 | Bar->new(list => [ { 1 => 2 }, 2, 3 ]); |
537873b0 |
130 | } qr/Attribute \(list\) does not pass the type constraint because: Validation failed for 'Bar::List' with value/, "Bad coercion parameter throws an error"; |
310ad28b |
131 | } |
132 | |
a133bcea |
133 | use Mouse::Util::TypeConstraints; |
134 | |
135 | my $t = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); |
136 | ok $t->is_a_type_of($t), "$t is a type of $t"; |
137 | ok $t->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
138 | |
139 | # XXX: how about 'MaybeInt[ Int ]'? |
140 | ok $t->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
141 | |
142 | ok!$t->is_a_type_of('Int'); |
143 | |
144 | ok $t->check(10); |
145 | ok $t->check(undef); |
146 | ok!$t->check(3.14); |
147 | |
148 | my $u = subtype 'MaybeInt', as 'Maybe[Int]'; |
149 | ok $u->is_a_type_of($t), "$t is a type of $t"; |
150 | ok $u->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
151 | |
152 | # XXX: how about 'MaybeInt[ Int ]'? |
153 | ok $u->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
154 | |
155 | ok!$u->is_a_type_of('Int'); |
156 | |
157 | ok $u->check(10); |
158 | ok $u->check(undef); |
159 | ok!$u->check(3.14); |
160 | |
161 | # XXX: undefined hehaviour |
162 | # ok $t->is_a_type_of($u); |
163 | # ok $u->is_a_type_of($t); |
164 | |
165 | my $w = subtype as 'Maybe[ ArrayRef | HashRef ]'; |
166 | |
167 | ok $w->check(undef); |
168 | ok $w->check([]); |
169 | ok $w->check({}); |
170 | ok!$w->check(sub{}); |
171 | |
172 | ok $w->is_a_type_of('Maybe'); |
173 | ok $w->is_a_type_of('Maybe[ArrayRef|HashRef]'); |
174 | ok!$w->is_a_type_of('ArrayRef'); |
175 | |
176 | my $x = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[ ArrayRef[ Int | Undef ] ]'); |
177 | |
178 | ok $x->is_a_type_of('ArrayRef'); |
179 | ok $x->is_a_type_of('ArrayRef[ArrayRef[Int|Undef]]'); |
180 | ok!$x->is_a_type_of('ArrayRef[ArrayRef[Str]]'); |
181 | |
182 | ok $x->check([]); |
183 | ok $x->check([[]]); |
184 | ok $x->check([[10]]); |
185 | ok $x->check([[10, undef]]); |
186 | ok!$x->check([[10, 3.14]]); |
187 | ok!$x->check({}); |
315b97c2 |
188 | |
24dd8fef |
189 | $x = tie my @ta, 'Tie::StdArray'; |
5fa003bf |
190 | |
24dd8fef |
191 | my $array_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]'); |
192 | |
193 | @$x = (1, 2, 3); |
194 | ok $array_of_int->check(\@ta), 'magical array'; |
195 | |
196 | @$x = (1, 2, 3.14); |
197 | ok !$array_of_int->check(\@ta); |
198 | |
199 | $x = tie my %th, 'Tie::StdHash'; |
200 | |
201 | my $hash_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('HashRef[Int]'); |
202 | |
203 | %$x = (foo => 1, bar => 3, baz => 5); |
204 | ok $hash_of_int->check(\%th), 'magical hash'; |
205 | |
206 | $x->{foo} = 3.14; |
207 | ok!$hash_of_int->check(\%th); |
208 | |
209 | my %th_clone; |
210 | while(my($k, $v) = each %th){ |
211 | $th_clone{$k} = $v; |
212 | } |
213 | |
fc83f4cf |
214 | is( $hash_of_int->type_parameter, 'Int' ); |
215 | |
216 | if('Mouse' eq ('Mo' . 'use')){ # under Mouse |
217 | ok $hash_of_int->__is_parameterized(); |
218 | ok!$hash_of_int->type_parameter->__is_parameterized(); |
219 | } |
220 | else{ # under Moose |
221 | ok $hash_of_int->can('type_parameter'); |
222 | ok!$hash_of_int->type_parameter->can('type_parameter'); |
223 | } |
224 | |
24dd8fef |
225 | is_deeply \%th_clone, \%th, 'the hash iterator is initialized'; |
eed39dff |
226 | |
227 | { |
228 | my $myhashref = subtype 'MyHashRef', |
229 | as 'HashRef[Value]', |
230 | where { keys %$_ > 1 }; |
231 | |
232 | ok $myhashref->is_a_type_of('HashRef'), "$myhashref"; |
233 | ok $myhashref->check({ a => 43, b => 100 }); |
234 | ok $myhashref->check({ a => 43, b => 3.14 }); |
235 | ok !$myhashref->check({}); |
236 | ok !$myhashref->check({ a => 42, b => [] }); |
237 | |
238 | is $myhashref->type_parameter, 'Value'; |
239 | |
240 | $myhashref = subtype 'H', as 'MyHashRef[Int]'; |
241 | |
242 | ok $myhashref->is_a_type_of('HashRef'), "$myhashref"; |
243 | ok $myhashref->check({ a => 43, b => 100 }); |
244 | ok !$myhashref->check({ a => 43, b => 3.14 }); |
245 | ok !$myhashref->check({}); |
246 | ok !$myhashref->check({ a => 42, b => [] }); |
247 | |
248 | is $myhashref->type_parameter, 'Int'; |
249 | } |
250 | |
251 | done_testing; |
252 | |