Commit | Line | Data |
5fa003bf |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
fc83f4cf |
4 | use Test::More tests => 54; |
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' }); |
72 | } 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"; |
73 | |
74 | throws_ok { |
75 | Foo->new( bar => [ a => 'b' ]); |
76 | } 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"; |
77 | |
78 | throws_ok { |
79 | Foo->new( complex => [ { a => 1, b => 1 }, { c => "d", e => "f" } ] ) |
80 | } 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 |
81 | |
82 | throws_ok { |
83 | Foo->new( my_class => [ 10 ] ); |
84 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' failed with value/; |
85 | throws_ok { |
86 | Foo->new( my_class => [ {foo => 'bar'} ] ); |
87 | } qr/Attribute \(my_class\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Class\]' failed with value/; |
88 | |
89 | |
90 | throws_ok { |
91 | Foo->new( my_role => [ 20 ] ); |
92 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' failed with value/; |
93 | throws_ok { |
94 | Foo->new( my_role => [ {foo => 'bar'} ] ); |
95 | } qr/Attribute \(my_role\) does not pass the type constraint because: Validation failed for 'ArrayRef\[My::Role\]' failed 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"); |
125 | } "coercion works"; |
126 | |
127 | throws_ok { |
128 | Bar->new(list => [ { 1 => 2 }, 2, 3 ]); |
129 | } qr/Attribute \(list\) does not pass the type constraint because: Validation failed for 'Bar::List' failed with value/, "Bad coercion parameter throws an error"; |
130 | } |
131 | |
a133bcea |
132 | use Mouse::Util::TypeConstraints; |
133 | |
134 | my $t = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]'); |
135 | ok $t->is_a_type_of($t), "$t is a type of $t"; |
136 | ok $t->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
137 | |
138 | # XXX: how about 'MaybeInt[ Int ]'? |
139 | ok $t->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
140 | |
141 | ok!$t->is_a_type_of('Int'); |
142 | |
143 | ok $t->check(10); |
144 | ok $t->check(undef); |
145 | ok!$t->check(3.14); |
146 | |
147 | my $u = subtype 'MaybeInt', as 'Maybe[Int]'; |
148 | ok $u->is_a_type_of($t), "$t is a type of $t"; |
149 | ok $u->is_a_type_of('Maybe'), "$t is a type of Maybe"; |
150 | |
151 | # XXX: how about 'MaybeInt[ Int ]'? |
152 | ok $u->is_a_type_of('Maybe[Int]'), "$t is a type of Maybe[Int]"; |
153 | |
154 | ok!$u->is_a_type_of('Int'); |
155 | |
156 | ok $u->check(10); |
157 | ok $u->check(undef); |
158 | ok!$u->check(3.14); |
159 | |
160 | # XXX: undefined hehaviour |
161 | # ok $t->is_a_type_of($u); |
162 | # ok $u->is_a_type_of($t); |
163 | |
164 | my $w = subtype as 'Maybe[ ArrayRef | HashRef ]'; |
165 | |
166 | ok $w->check(undef); |
167 | ok $w->check([]); |
168 | ok $w->check({}); |
169 | ok!$w->check(sub{}); |
170 | |
171 | ok $w->is_a_type_of('Maybe'); |
172 | ok $w->is_a_type_of('Maybe[ArrayRef|HashRef]'); |
173 | ok!$w->is_a_type_of('ArrayRef'); |
174 | |
175 | my $x = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[ ArrayRef[ Int | Undef ] ]'); |
176 | |
177 | ok $x->is_a_type_of('ArrayRef'); |
178 | ok $x->is_a_type_of('ArrayRef[ArrayRef[Int|Undef]]'); |
179 | ok!$x->is_a_type_of('ArrayRef[ArrayRef[Str]]'); |
180 | |
181 | ok $x->check([]); |
182 | ok $x->check([[]]); |
183 | ok $x->check([[10]]); |
184 | ok $x->check([[10, undef]]); |
185 | ok!$x->check([[10, 3.14]]); |
186 | ok!$x->check({}); |
315b97c2 |
187 | |
24dd8fef |
188 | $x = tie my @ta, 'Tie::StdArray'; |
5fa003bf |
189 | |
24dd8fef |
190 | my $array_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int]'); |
191 | |
192 | @$x = (1, 2, 3); |
193 | ok $array_of_int->check(\@ta), 'magical array'; |
194 | |
195 | @$x = (1, 2, 3.14); |
196 | ok !$array_of_int->check(\@ta); |
197 | |
198 | $x = tie my %th, 'Tie::StdHash'; |
199 | |
200 | my $hash_of_int = Mouse::Util::TypeConstraints::find_or_parse_type_constraint('HashRef[Int]'); |
201 | |
202 | %$x = (foo => 1, bar => 3, baz => 5); |
203 | ok $hash_of_int->check(\%th), 'magical hash'; |
204 | |
205 | $x->{foo} = 3.14; |
206 | ok!$hash_of_int->check(\%th); |
207 | |
208 | my %th_clone; |
209 | while(my($k, $v) = each %th){ |
210 | $th_clone{$k} = $v; |
211 | } |
212 | |
fc83f4cf |
213 | is( $hash_of_int->type_parameter, 'Int' ); |
214 | |
215 | if('Mouse' eq ('Mo' . 'use')){ # under Mouse |
216 | ok $hash_of_int->__is_parameterized(); |
217 | ok!$hash_of_int->type_parameter->__is_parameterized(); |
218 | } |
219 | else{ # under Moose |
220 | ok $hash_of_int->can('type_parameter'); |
221 | ok!$hash_of_int->type_parameter->can('type_parameter'); |
222 | } |
223 | |
24dd8fef |
224 | is_deeply \%th_clone, \%th, 'the hash iterator is initialized'; |