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