Commit | Line | Data |
c2463b82 |
1 | #!/usr/bin/env perl |
2 | use warnings; |
3 | use strict; |
4 | |
905ff8f2 |
5 | use Test::More tests => 62; |
a706b0f2 |
6 | use Test::Exception; |
c2463b82 |
7 | use FindBin; |
8 | use lib "$FindBin::Bin/lib"; |
c2463b82 |
9 | |
20b6a7d1 |
10 | { |
11 | package Test::MooseX::TypeLibrary::TypeDecorator; |
12 | |
13 | use Moose; |
a706b0f2 |
14 | use MooseX::Types::Moose qw( |
575e6fc1 |
15 | Int Str ArrayRef HashRef Object |
a706b0f2 |
16 | ); |
20b6a7d1 |
17 | use DecoratorLibrary qw( |
cf1a8bfa |
18 | MyArrayRefBase MyArrayRefInt01 MyArrayRefInt02 StrOrArrayRef |
905ff8f2 |
19 | AtLeastOneInt Jobs SubOfMyArrayRefInt01 WierdIntergersArrayRef1 |
20 | WierdIntergersArrayRef2 |
20b6a7d1 |
21 | ); |
22 | |
23 | has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1); |
24 | has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1); |
a706b0f2 |
25 | has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1); |
26 | has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]); |
cf1a8bfa |
27 | has 'StrOrArrayRef' => (is=>'rw', isa=>StrOrArrayRef); |
e088dd03 |
28 | has 'AtLeastOneInt' => (is=>'rw', isa=>AtLeastOneInt); |
575e6fc1 |
29 | has 'pipeoverloading' => (is=>'rw', isa=>Int|Str); |
475bbd1d |
30 | has 'deep' => (is=>'rw', isa=>ArrayRef[ArrayRef[HashRef[Int]]] ); |
575e6fc1 |
31 | has 'deep2' => (is=>'rw', isa=>ArrayRef[Int|ArrayRef[HashRef[Int|Object]]] ); |
686e5888 |
32 | has 'enum' => (is=>'rw', isa=>Jobs); |
48a2379b |
33 | has 'SubOfMyArrayRefInt01_attr' => (is=>'rw', isa=>SubOfMyArrayRefInt01); |
905ff8f2 |
34 | has 'WierdIntergersArrayRef1_attr' => (is=>'rw', isa=>WierdIntergersArrayRef1); |
35 | has 'WierdIntergersArrayRef2_attr' => (is=>'rw', isa=>WierdIntergersArrayRef2); |
20b6a7d1 |
36 | } |
c2463b82 |
37 | |
20b6a7d1 |
38 | ## Make sure we have a 'create object sanity check' |
39 | |
40 | ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(), |
41 | => 'Created some sort of object'; |
42 | |
43 | isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator' |
44 | => "Yes, it's the correct kind of object"; |
45 | |
46 | ## test arrayrefbase normal and coercion |
47 | |
bb5b7b28 |
48 | ok $type->arrayrefbase([qw(a b c d e)]) |
49 | => 'Assigned arrayrefbase qw(a b c d e)'; |
20b6a7d1 |
50 | |
bb5b7b28 |
51 | is_deeply $type->arrayrefbase, [qw(a b c d e)], |
a706b0f2 |
52 | => 'Assignment is correct'; |
20b6a7d1 |
53 | |
54 | ok $type->arrayrefbase('d,e,f') |
a706b0f2 |
55 | => 'Assignment arrayrefbase d,e,f to test coercion'; |
20b6a7d1 |
56 | |
57 | is_deeply $type->arrayrefbase, [qw(d e f)], |
a706b0f2 |
58 | => 'Assignment and coercion is correct'; |
20b6a7d1 |
59 | |
60 | ## test arrayrefint01 normal and coercion |
61 | |
54f5d4e6 |
62 | ok $type->arrayrefint01([qw(1 2 3)]) |
a706b0f2 |
63 | => 'Assignment arrayrefint01 qw(1 2 3)'; |
20b6a7d1 |
64 | |
54f5d4e6 |
65 | is_deeply $type->arrayrefint01, [qw(1 2 3)], |
a706b0f2 |
66 | => 'Assignment is correct'; |
20b6a7d1 |
67 | |
54f5d4e6 |
68 | ok $type->arrayrefint01('4.5.6') |
a706b0f2 |
69 | => 'Assigned arrayrefint01 4.5.6 to test coercion from Str'; |
20b6a7d1 |
70 | |
54f5d4e6 |
71 | is_deeply $type->arrayrefint01, [qw(4 5 6)], |
a706b0f2 |
72 | => 'Assignment and coercion is correct'; |
20b6a7d1 |
73 | |
54f5d4e6 |
74 | ok $type->arrayrefint01({a=>7,b=>8}) |
a706b0f2 |
75 | => 'Assigned arrayrefint01 {a=>7,b=>8} to test coercion from HashRef'; |
54f5d4e6 |
76 | |
77 | is_deeply $type->arrayrefint01, [qw(7 8)], |
a706b0f2 |
78 | => 'Assignment and coercion is correct'; |
79 | |
80 | throws_ok sub { |
81 | $type->arrayrefint01([qw(a b c)]) |
82 | }, qr/Attribute \(arrayrefint01\) does not pass the type constraint/ => 'Dies when values are strings'; |
83 | |
84 | ## test arrayrefint02 normal and coercion |
85 | |
86 | ok $type->arrayrefint02([qw(1 2 3)]) |
87 | => 'Assigned arrayrefint02 qw(1 2 3)'; |
88 | |
89 | is_deeply $type->arrayrefint02, [qw(1 2 3)], |
90 | => 'Assignment is correct'; |
91 | |
92 | ok $type->arrayrefint02('4:5:6') |
93 | => 'Assigned arrayrefint02 4:5:6 to test coercion from Str'; |
94 | |
95 | is_deeply $type->arrayrefint02, [qw(4 5 6)], |
96 | => 'Assignment and coercion is correct'; |
97 | |
98 | ok $type->arrayrefint02({a=>7,b=>8}) |
99 | => 'Assigned arrayrefint02 {a=>7,b=>8} to test coercion from HashRef'; |
100 | |
101 | is_deeply $type->arrayrefint02, [qw(7 8)], |
102 | => 'Assignment and coercion is correct'; |
103 | |
104 | ok $type->arrayrefint02({a=>'AA',b=>'BBB', c=>'CCCCCCC'}) |
105 | => "Assigned arrayrefint02 {a=>'AA',b=>'BBB', c=>'CCCCCCC'} to test coercion from HashRef"; |
106 | |
107 | is_deeply $type->arrayrefint02, [qw(2 3 7)], |
108 | => 'Assignment and coercion is correct'; |
109 | |
110 | ok $type->arrayrefint02({a=>[1,2],b=>[3,4]}) |
111 | => "Assigned arrayrefint02 {a=>[1,2],b=>[3,4]} to test coercion from HashRef"; |
112 | |
113 | is_deeply $type->arrayrefint02, [qw(1 2 3 4)], |
114 | => 'Assignment and coercion is correct'; |
115 | |
116 | # test arrayrefint03 |
117 | |
118 | ok $type->arrayrefint03([qw(11 12 13)]) |
119 | => 'Assigned arrayrefint01 qw(11 12 13)'; |
120 | |
121 | is_deeply $type->arrayrefint03, [qw(11 12 13)], |
122 | => 'Assignment is correct'; |
54f5d4e6 |
123 | |
a706b0f2 |
124 | throws_ok sub { |
125 | $type->arrayrefint03([qw(a b c)]) |
cf1a8bfa |
126 | }, qr/Attribute \(arrayrefint03\) does not pass the type constraint/ => 'Dies when values are strings'; |
127 | |
128 | # TEST StrOrArrayRef |
129 | |
130 | ok $type->StrOrArrayRef('string') |
131 | => 'String part of union is good'; |
132 | |
133 | ok $type->StrOrArrayRef([1,2,3]) |
134 | => 'arrayref part of union is good'; |
135 | |
136 | throws_ok sub { |
137 | $type->StrOrArrayRef({a=>111}); |
e088dd03 |
138 | }, qr/Attribute \(StrOrArrayRef\) does not pass the type constraint/ => 'Correctly failed to use a hashref'; |
139 | |
140 | # Test AtLeastOneInt |
141 | |
142 | ok $type->AtLeastOneInt([1,2]), |
143 | => 'Good assignment'; |
144 | |
145 | is_deeply $type->AtLeastOneInt, [1,2] |
146 | => "Got expected values."; |
147 | |
148 | throws_ok sub { |
149 | $type->AtLeastOneInt([]); |
d9002a85 |
150 | }, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails to assign as []'; |
e088dd03 |
151 | |
152 | throws_ok sub { |
153 | $type->AtLeastOneInt(['a','b']); |
154 | }, qr/Attribute \(AtLeastOneInt\) does not pass the type constraint/ => 'properly fails arrayref of strings'; |
155 | |
377378b8 |
156 | ## Test pipeoverloading |
157 | |
158 | ok $type->pipeoverloading(1) |
159 | => 'Integer for union test accepted'; |
160 | |
161 | ok $type->pipeoverloading('a') |
162 | => 'String for union test accepted'; |
163 | |
164 | throws_ok sub { |
165 | $type->pipeoverloading({a=>1,b=>2}); |
575e6fc1 |
166 | }, qr/Validation failed for 'Int|Str'/ => 'Union test corrected fails a HashRef'; |
377378b8 |
167 | |
575e6fc1 |
168 | ## test deep (ArrayRef[ArrayRef[HashRef[Int]]]) |
377378b8 |
169 | |
170 | ok $type->deep([[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]) |
171 | => 'Assigned deep to [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]'; |
172 | |
173 | is_deeply $type->deep, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]], |
174 | => 'Assignment is correct'; |
175 | |
176 | throws_ok sub { |
177 | $type->deep({a=>1,b=>2}); |
575e6fc1 |
178 | }, qr/Attribute \(deep\) does not pass the type constraint/ => 'Deep Constraints properly fail'; |
179 | |
180 | # test deep2 (ArrayRef[Int|ArrayRef[HashRef[Int|Object]]]) |
181 | |
182 | ok $type->deep2([[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]) |
764e65c8 |
183 | => 'Assigned deep2 to [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]]'; |
575e6fc1 |
184 | |
185 | is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>4}],[{e=>5}]], |
186 | => 'Assignment is correct'; |
187 | |
188 | throws_ok sub { |
189 | $type->deep2({a=>1,b=>2}); |
190 | }, qr/Attribute \(deep2\) does not pass the type constraint/ => 'Deep Constraints properly fail'; |
191 | |
192 | throws_ok sub { |
193 | $type->deep2([[{a=>1,b=>2},{c=>3,d=>'noway'}],[{e=>5}]]); |
194 | }, qr/Attribute \(deep2\) does not pass the type constraint/ => 'Deep Constraints properly fail'; |
195 | |
196 | |
197 | ok $type->deep2([[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]]) |
764e65c8 |
198 | => 'Assigned deep2 to [[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]]'; |
575e6fc1 |
199 | |
200 | |
201 | is_deeply $type->deep2, [[{a=>1,b=>2},{c=>3,d=>$type}],[{e=>5}]], |
202 | => 'Assignment is correct'; |
203 | |
204 | ok $type->deep2([1,2,3]) |
764e65c8 |
205 | => 'Assigned deep2 to [1,2,3]'; |
575e6fc1 |
206 | |
207 | |
208 | is_deeply $type->deep2, [1,2,3], |
209 | => 'Assignment is correct'; |
686e5888 |
210 | |
211 | ## Test jobs |
212 | |
213 | ok $type->enum('Programming') |
214 | => 'Good Assignment of Programming to Enum'; |
215 | |
216 | |
217 | throws_ok sub { |
218 | $type->enum('ddddd'); |
219 | }, qr/Attribute \(enum\) does not pass the type constraint/ => 'Enum properly fails'; |
48a2379b |
220 | |
221 | ## Test SubOfMyArrayRefInt01_attr |
222 | |
223 | ok $type->SubOfMyArrayRefInt01_attr([15,20,25]) |
224 | => 'Assigned SubOfMyArrayRefInt01_attr to [15,20,25]'; |
225 | |
226 | is_deeply $type->SubOfMyArrayRefInt01_attr, [15,20,25], |
227 | => 'Assignment is correct'; |
228 | |
229 | throws_ok sub { |
230 | $type->SubOfMyArrayRefInt01_attr([15,5,20]); |
905ff8f2 |
231 | }, qr/Attribute \(SubOfMyArrayRefInt01_attr\) does not pass the type constraint/ |
232 | => 'SubOfMyArrayRefInt01 Constraints properly fail'; |
233 | |
234 | ## test WierdIntergersArrayRef1 |
235 | |
236 | ok $type->WierdIntergersArrayRef1_attr([5,10,1000]) |
237 | => 'Assigned deep2 to [5,10,1000]'; |
238 | |
239 | is_deeply $type->WierdIntergersArrayRef1_attr, [5,10,1000], |
240 | => 'Assignment is correct'; |
241 | |
242 | throws_ok sub { |
243 | $type->WierdIntergersArrayRef1_attr({a=>1,b=>2}); |
244 | }, qr/Attribute \(WierdIntergersArrayRef1_attr\) does not pass the type constraint/ |
245 | => 'Constraints properly fail'; |
246 | |
247 | throws_ok sub { |
248 | $type->WierdIntergersArrayRef1_attr([5,10,1]); |
249 | }, qr/Attribute \(WierdIntergersArrayRef1_attr\) does not pass the type constraint/ |
250 | => 'Constraints properly fail'; |
251 | |
252 | throws_ok sub { |
253 | $type->WierdIntergersArrayRef1_attr([1]); |
254 | }, qr/Attribute \(WierdIntergersArrayRef1_attr\) does not pass the type constraint/ |
255 | => 'Constraints properly fail'; |
256 | |
257 | ## test WierdIntergersArrayRef2 |
258 | |
259 | ok $type->WierdIntergersArrayRef2_attr([5,10,$type]) |
260 | => 'Assigned deep2 to [5,10,$type]'; |
261 | |
262 | is_deeply $type->WierdIntergersArrayRef2_attr, [5,10,$type], |
263 | => 'Assignment is correct'; |
264 | |
265 | throws_ok sub { |
266 | $type->WierdIntergersArrayRef2_attr({a=>1,b=>2}); |
267 | }, qr/Attribute \(WierdIntergersArrayRef2_attr\) does not pass the type constraint/ |
268 | => 'Constraints properly fail'; |
269 | |
270 | throws_ok sub { |
271 | $type->WierdIntergersArrayRef2_attr([5,10,1]); |
272 | }, qr/Attribute \(WierdIntergersArrayRef2_attr\) does not pass the type constraint/ |
273 | => 'Constraints properly fail'; |
274 | |
275 | throws_ok sub { |
276 | $type->WierdIntergersArrayRef2_attr([1]); |
277 | }, qr/Attribute \(WierdIntergersArrayRef2_attr\) does not pass the type constraint/ |
278 | => 'Constraints properly fail'; |
279 | |
280 | |
281 | |
282 | |