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 | ); |
33 | has array_int => ( |
34 | traits => ['Array'], |
35 | is => 'rw', |
36 | isa => 'ArrayRef[Int]', |
37 | handles => { |
38 | push_array_int => 'push', |
39 | }, |
40 | ); |
41 | has a1 => ( |
42 | traits => ['Array'], |
43 | is => 'rw', |
44 | isa => 'A1', |
45 | handles => { |
46 | push_a1 => 'push', |
47 | }, |
48 | ); |
49 | has a2 => ( |
50 | traits => ['Array'], |
51 | is => 'rw', |
52 | isa => 'A2', |
53 | handles => { |
54 | push_a2 => 'push', |
55 | }, |
56 | ); |
57 | has a3 => ( |
58 | traits => ['Array'], |
59 | is => 'rw', |
60 | isa => 'A3', |
61 | handles => { |
62 | push_a3 => 'push', |
63 | }, |
64 | ); |
7a431e9c |
65 | has a4 => ( |
66 | traits => ['Array'], |
67 | is => 'rw', |
68 | isa => 'ArrayRef', |
69 | lazy => 1, |
70 | default => 'invalid', |
71 | clearer => '_clear_a4', |
72 | handles => { |
603454da |
73 | get_a4 => 'get', |
7a431e9c |
74 | push_a4 => 'push', |
75 | accessor_a4 => 'accessor', |
76 | }, |
77 | ); |
603454da |
78 | has a5 => ( |
79 | traits => ['Array'], |
80 | is => 'rw', |
81 | isa => 'A5', |
82 | coerce => 1, |
83 | lazy => 1, |
84 | default => 'invalid', |
85 | clearer => '_clear_a5', |
86 | handles => { |
87 | get_a5 => 'get', |
88 | push_a5 => 'push', |
89 | accessor_a5 => 'accessor', |
90 | }, |
91 | ); |
06d16be0 |
92 | } |
93 | |
94 | my $foo = Foo->new; |
95 | |
96 | { |
ee588adf |
97 | $foo->array( [] ); |
98 | is_deeply( $foo->array, [], "array - correct contents" ); |
06d16be0 |
99 | |
100 | $foo->push_array('foo'); |
ee588adf |
101 | is_deeply( $foo->array, ['foo'], "array - correct contents" ); |
06d16be0 |
102 | } |
103 | |
104 | { |
ee588adf |
105 | $foo->array_int( [] ); |
106 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
107 | |
b10dde3a |
108 | isnt( exception { $foo->push_array_int('foo') }, undef, "array_int - can't push wrong type" ); |
ee588adf |
109 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
110 | |
111 | $foo->push_array_int(1); |
ee588adf |
112 | is_deeply( $foo->array_int, [1], "array_int - correct contents" ); |
06d16be0 |
113 | } |
114 | |
115 | { |
b10dde3a |
116 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push onto undef" ); |
ee588adf |
117 | |
118 | $foo->a1( [] ); |
119 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
120 | |
b10dde3a |
121 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push wrong type" ); |
ee588adf |
122 | |
123 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
06d16be0 |
124 | |
125 | $foo->push_a1(1); |
ee588adf |
126 | is_deeply( $foo->a1, [1], "a1 - correct contents" ); |
06d16be0 |
127 | } |
128 | |
129 | { |
b10dde3a |
130 | isnt( exception { $foo->push_a2('foo') }, undef, "a2 - can't push onto undef" ); |
06d16be0 |
131 | |
ee588adf |
132 | $foo->a2( [] ); |
133 | is_deeply( $foo->a2, [], "a2 - correct contents" ); |
06d16be0 |
134 | |
135 | $foo->push_a2('foo'); |
ee588adf |
136 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
137 | |
b10dde3a |
138 | isnt( exception { $foo->push_a2('bar') }, undef, "a2 - can't push more than one element" ); |
ee588adf |
139 | |
140 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
06d16be0 |
141 | } |
142 | |
143 | { |
b10dde3a |
144 | isnt( exception { $foo->push_a3(1) }, undef, "a3 - can't push onto undef" ); |
ee588adf |
145 | |
146 | $foo->a3( [] ); |
147 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
148 | |
b10dde3a |
149 | isnt( exception { $foo->push_a3('foo') }, undef, "a3 - can't push non-int" ); |
ee588adf |
150 | |
b10dde3a |
151 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
152 | |
153 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
06d16be0 |
154 | |
155 | $foo->push_a3(1); |
ee588adf |
156 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
157 | |
b10dde3a |
158 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
159 | |
160 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
06d16be0 |
161 | |
162 | $foo->push_a3(3); |
ee588adf |
163 | is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" ); |
06d16be0 |
164 | } |
165 | |
7a431e9c |
166 | { |
167 | my $expect = qr/\QAttribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value invalid/; |
168 | |
169 | like( |
170 | exception { $foo->accessor_a4(0); }, |
171 | $expect, |
172 | 'invalid default is caught when trying to read via accessor' |
173 | ); |
174 | |
175 | like( |
176 | exception { $foo->accessor_a4(0 => 42); }, |
177 | $expect, |
178 | 'invalid default is caught when trying to write via accessor' |
179 | ); |
180 | |
181 | like( |
182 | exception { $foo->push_a4(42); }, |
183 | $expect, |
184 | 'invalid default is caught when trying to push' |
185 | ); |
186 | |
187 | like( |
188 | exception { $foo->get_a4(42); }, |
189 | $expect, |
190 | 'invalid default is caught when trying to get' |
191 | ); |
192 | } |
193 | |
603454da |
194 | { |
195 | my $foo = Foo->new; |
196 | |
197 | is( |
198 | $foo->accessor_a5(0), 'invalid', |
199 | 'lazy default is coerced when trying to read via accessor' |
200 | ); |
201 | |
202 | $foo->_clear_a5; |
203 | |
204 | $foo->accessor_a5( 1 => 'thing' ); |
205 | |
206 | is_deeply( |
207 | $foo->a5, |
208 | [ 'invalid', 'thing' ], |
209 | 'lazy default is coerced when trying to write via accessor' |
210 | ); |
211 | |
212 | $foo->_clear_a5; |
213 | |
214 | $foo->push_a5('thing'); |
215 | |
216 | is_deeply( |
217 | $foo->a5, |
218 | [ 'invalid', 'thing' ], |
219 | 'lazy default is coerced when trying to push' |
220 | ); |
221 | |
222 | $foo->_clear_a5; |
223 | |
224 | is( |
225 | $foo->get_a5(0), 'invalid', |
226 | 'lazy default is coerced when trying to get' |
227 | ); |
228 | } |
229 | |
06d16be0 |
230 | done_testing; |