Commit | Line | Data |
06d16be0 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
b10dde3a |
5 | use Test::Fatal; |
06d16be0 |
6 | |
7 | { |
8 | use Moose::Util::TypeConstraints; |
9 | use List::Util qw(sum); |
10 | |
11 | subtype 'A1', as 'ArrayRef[Int]'; |
ee588adf |
12 | subtype 'A2', as 'ArrayRef', where { @$_ < 2 }; |
435e394d |
13 | subtype 'A3', as 'ArrayRef[Int]', where { ( sum(@$_) || 0 ) < 5 }; |
06d16be0 |
14 | |
603454da |
15 | subtype 'A5', as 'ArrayRef'; |
16 | coerce 'A5', from 'Str', via { [ $_ ] }; |
17 | |
06d16be0 |
18 | no Moose::Util::TypeConstraints; |
19 | } |
20 | |
21 | { |
22 | package Foo; |
23 | use Moose; |
24 | |
25 | has array => ( |
26 | traits => ['Array'], |
27 | is => 'rw', |
28 | isa => 'ArrayRef', |
29 | handles => { |
30 | push_array => 'push', |
31 | }, |
32 | ); |
18c76b1c |
33 | |
06d16be0 |
34 | has array_int => ( |
35 | traits => ['Array'], |
36 | is => 'rw', |
37 | isa => 'ArrayRef[Int]', |
38 | handles => { |
39 | push_array_int => 'push', |
40 | }, |
41 | ); |
18c76b1c |
42 | |
06d16be0 |
43 | has a1 => ( |
44 | traits => ['Array'], |
45 | is => 'rw', |
46 | isa => 'A1', |
47 | handles => { |
48 | push_a1 => 'push', |
49 | }, |
50 | ); |
18c76b1c |
51 | |
06d16be0 |
52 | has a2 => ( |
53 | traits => ['Array'], |
54 | is => 'rw', |
55 | isa => 'A2', |
56 | handles => { |
57 | push_a2 => 'push', |
58 | }, |
59 | ); |
18c76b1c |
60 | |
06d16be0 |
61 | has a3 => ( |
62 | traits => ['Array'], |
63 | is => 'rw', |
64 | isa => 'A3', |
65 | handles => { |
66 | push_a3 => 'push', |
67 | }, |
68 | ); |
18c76b1c |
69 | |
7a431e9c |
70 | has a4 => ( |
71 | traits => ['Array'], |
72 | is => 'rw', |
73 | isa => 'ArrayRef', |
74 | lazy => 1, |
75 | default => 'invalid', |
76 | clearer => '_clear_a4', |
77 | handles => { |
603454da |
78 | get_a4 => 'get', |
7a431e9c |
79 | push_a4 => 'push', |
80 | accessor_a4 => 'accessor', |
81 | }, |
82 | ); |
18c76b1c |
83 | |
603454da |
84 | has a5 => ( |
85 | traits => ['Array'], |
86 | is => 'rw', |
87 | isa => 'A5', |
88 | coerce => 1, |
89 | lazy => 1, |
90 | default => 'invalid', |
91 | clearer => '_clear_a5', |
92 | handles => { |
93 | get_a5 => 'get', |
94 | push_a5 => 'push', |
95 | accessor_a5 => 'accessor', |
96 | }, |
97 | ); |
06d16be0 |
98 | } |
99 | |
100 | my $foo = Foo->new; |
101 | |
102 | { |
ee588adf |
103 | $foo->array( [] ); |
104 | is_deeply( $foo->array, [], "array - correct contents" ); |
06d16be0 |
105 | |
106 | $foo->push_array('foo'); |
ee588adf |
107 | is_deeply( $foo->array, ['foo'], "array - correct contents" ); |
06d16be0 |
108 | } |
109 | |
110 | { |
ee588adf |
111 | $foo->array_int( [] ); |
112 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
113 | |
b10dde3a |
114 | isnt( exception { $foo->push_array_int('foo') }, undef, "array_int - can't push wrong type" ); |
ee588adf |
115 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
116 | |
117 | $foo->push_array_int(1); |
ee588adf |
118 | is_deeply( $foo->array_int, [1], "array_int - correct contents" ); |
06d16be0 |
119 | } |
120 | |
121 | { |
b10dde3a |
122 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push onto undef" ); |
ee588adf |
123 | |
124 | $foo->a1( [] ); |
125 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
126 | |
b10dde3a |
127 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push wrong type" ); |
ee588adf |
128 | |
129 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
06d16be0 |
130 | |
131 | $foo->push_a1(1); |
ee588adf |
132 | is_deeply( $foo->a1, [1], "a1 - correct contents" ); |
06d16be0 |
133 | } |
134 | |
135 | { |
b10dde3a |
136 | isnt( exception { $foo->push_a2('foo') }, undef, "a2 - can't push onto undef" ); |
06d16be0 |
137 | |
ee588adf |
138 | $foo->a2( [] ); |
139 | is_deeply( $foo->a2, [], "a2 - correct contents" ); |
06d16be0 |
140 | |
141 | $foo->push_a2('foo'); |
ee588adf |
142 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
143 | |
b10dde3a |
144 | isnt( exception { $foo->push_a2('bar') }, undef, "a2 - can't push more than one element" ); |
ee588adf |
145 | |
146 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
06d16be0 |
147 | } |
148 | |
149 | { |
b10dde3a |
150 | isnt( exception { $foo->push_a3(1) }, undef, "a3 - can't push onto undef" ); |
ee588adf |
151 | |
152 | $foo->a3( [] ); |
153 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
154 | |
b10dde3a |
155 | isnt( exception { $foo->push_a3('foo') }, undef, "a3 - can't push non-int" ); |
ee588adf |
156 | |
b10dde3a |
157 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
158 | |
159 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
06d16be0 |
160 | |
161 | $foo->push_a3(1); |
ee588adf |
162 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
163 | |
b10dde3a |
164 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
165 | |
166 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
06d16be0 |
167 | |
168 | $foo->push_a3(3); |
ee588adf |
169 | is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" ); |
06d16be0 |
170 | } |
171 | |
7a431e9c |
172 | { |
5325e317 |
173 | my $expect |
174 | = qr/\QAttribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value invalid/; |
7a431e9c |
175 | |
176 | like( |
177 | exception { $foo->accessor_a4(0); }, |
178 | $expect, |
179 | 'invalid default is caught when trying to read via accessor' |
180 | ); |
181 | |
182 | like( |
5325e317 |
183 | exception { $foo->accessor_a4( 0 => 42 ); }, |
7a431e9c |
184 | $expect, |
185 | 'invalid default is caught when trying to write via accessor' |
186 | ); |
187 | |
188 | like( |
189 | exception { $foo->push_a4(42); }, |
190 | $expect, |
191 | 'invalid default is caught when trying to push' |
192 | ); |
193 | |
194 | like( |
195 | exception { $foo->get_a4(42); }, |
196 | $expect, |
197 | 'invalid default is caught when trying to get' |
198 | ); |
199 | } |
200 | |
603454da |
201 | { |
202 | my $foo = Foo->new; |
203 | |
204 | is( |
205 | $foo->accessor_a5(0), 'invalid', |
206 | 'lazy default is coerced when trying to read via accessor' |
207 | ); |
208 | |
209 | $foo->_clear_a5; |
210 | |
211 | $foo->accessor_a5( 1 => 'thing' ); |
212 | |
213 | is_deeply( |
214 | $foo->a5, |
215 | [ 'invalid', 'thing' ], |
216 | 'lazy default is coerced when trying to write via accessor' |
217 | ); |
218 | |
219 | $foo->_clear_a5; |
220 | |
221 | $foo->push_a5('thing'); |
222 | |
223 | is_deeply( |
224 | $foo->a5, |
225 | [ 'invalid', 'thing' ], |
226 | 'lazy default is coerced when trying to push' |
227 | ); |
228 | |
229 | $foo->_clear_a5; |
230 | |
231 | is( |
232 | $foo->get_a5(0), 'invalid', |
233 | 'lazy default is coerced when trying to get' |
234 | ); |
235 | } |
236 | |
ea829e77 |
237 | { |
238 | package Bar; |
239 | use Moose; |
240 | } |
241 | |
242 | { |
243 | package HasArray; |
244 | use Moose; |
245 | |
246 | has objects => ( |
247 | isa => 'ArrayRef[Foo]', |
248 | traits => ['Array'], |
249 | handles => { |
250 | push_objects => 'push', |
251 | }, |
252 | ); |
253 | } |
254 | |
255 | { |
256 | my $ha = HasArray->new(); |
257 | |
258 | like( |
259 | exception { $ha->push_objects( Bar->new ) }, |
260 | qr/\QValidation failed for 'Foo'/, |
261 | 'got expected error when pushing an object of the wrong class onto an array ref' |
262 | ); |
263 | } |
264 | |
06d16be0 |
265 | done_testing; |