Commit | Line | Data |
0f24a39d |
1 | package SharedTests; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Scalar::Util qw( isweak ); |
54a288bd |
7 | use Test::More; |
8 | |
963254e0 |
9 | use vars qw($Lazy); |
10 | $Lazy = 0; |
0f24a39d |
11 | |
963254e0 |
12 | our %Attrs = ( |
13 | ObjectCount => { |
09f9282e |
14 | is => 'rw', |
15 | isa => 'Int', |
16 | default => 0, |
963254e0 |
17 | }, |
18 | WeakAttribute => { |
09f9282e |
19 | is => 'rw', |
20 | isa => 'Object', |
21 | weak_ref => 1, |
963254e0 |
22 | }, |
23 | LazyAttribute => { |
09f9282e |
24 | is => 'rw', |
25 | isa => 'Int', |
26 | lazy => 1, |
09f9282e |
27 | # The side effect is used to test that this was called |
28 | # lazily. |
29 | default => sub { $Lazy = 1 }, |
963254e0 |
30 | }, |
31 | ReadOnlyAttribute => { |
09f9282e |
32 | is => 'ro', |
33 | isa => 'Int', |
34 | default => 10, |
963254e0 |
35 | }, |
36 | ManyNames => { |
09f9282e |
37 | is => 'rw', |
38 | isa => 'Int', |
39 | reader => 'M', |
40 | writer => 'SetM', |
41 | clearer => 'ClearM', |
42 | predicate => 'HasM', |
963254e0 |
43 | }, |
44 | Delegatee => { |
09f9282e |
45 | is => 'rw', |
46 | isa => 'Delegatee', |
47 | handles => [ 'units', 'color' ], |
09f9282e |
48 | # if it's not lazy it makes a new object before we define |
49 | # Delegatee's attributes. |
50 | lazy => 1, |
51 | default => sub { Delegatee->new() }, |
963254e0 |
52 | }, |
53 | Mapping => { |
54 | traits => ['Hash'], |
55 | is => 'rw', |
56 | isa => 'HashRef[Str]', |
57 | default => sub { {} }, |
58 | handles => { |
59 | 'ExistsInMapping' => 'exists', |
60 | 'IdsInMapping' => 'keys', |
61 | 'GetMapping' => 'get', |
62 | 'SetMapping' => 'set', |
09f9282e |
63 | }, |
963254e0 |
64 | }, |
65 | Built => { |
09f9282e |
66 | is => 'ro', |
67 | builder => '_BuildIt', |
963254e0 |
68 | }, |
69 | LazyBuilt => { |
09f9282e |
70 | is => 'ro', |
71 | lazy => 1, |
72 | builder => '_BuildIt', |
963254e0 |
73 | }, |
74 | Triggerish => { |
09f9282e |
75 | is => 'rw', |
76 | trigger => sub { shift->_CallTrigger(@_) }, |
963254e0 |
77 | }, |
78 | ); |
79 | |
80 | { |
81 | package HasClassAttribute; |
82 | |
83 | use Moose qw( has ); |
84 | use MooseX::ClassAttribute; |
85 | |
86 | while ( my ( $name, $def ) = each %SharedTests::Attrs ) { |
87 | class_has $name => %{$def}; |
88 | } |
09f9282e |
89 | |
90 | has 'size' => ( |
91 | is => 'rw', |
92 | isa => 'Int', |
93 | default => 5, |
94 | ); |
0f24a39d |
95 | |
54a288bd |
96 | no Moose; |
54a288bd |
97 | |
09f9282e |
98 | sub BUILD { |
6b059c78 |
99 | my $self = shift; |
0f24a39d |
100 | |
6b059c78 |
101 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
0f24a39d |
102 | } |
54a288bd |
103 | |
09f9282e |
104 | sub _BuildIt {42} |
6048a053 |
105 | |
8207dfe7 |
106 | our @Triggered; |
09f9282e |
107 | |
108 | sub _CallTrigger { |
8207dfe7 |
109 | push @Triggered, [@_]; |
110 | } |
111 | |
09f9282e |
112 | sub make_immutable { |
54a288bd |
113 | my $class = shift; |
114 | |
115 | $class->meta()->make_immutable(); |
54a288bd |
116 | Delegatee->meta()->make_immutable(); |
117 | } |
118 | } |
119 | |
120 | { |
121 | package Delegatee; |
122 | |
123 | use Moose; |
124 | |
09f9282e |
125 | has 'units' => ( |
126 | is => 'ro', |
127 | default => 5, |
128 | ); |
54a288bd |
129 | |
09f9282e |
130 | has 'color' => ( |
131 | is => 'ro', |
132 | default => 'blue', |
133 | ); |
7a8e32bc |
134 | |
135 | no Moose; |
54a288bd |
136 | } |
137 | |
138 | { |
139 | package Child; |
140 | |
141 | use Moose; |
142 | use MooseX::ClassAttribute; |
143 | |
144 | extends 'HasClassAttribute'; |
145 | |
09f9282e |
146 | class_has '+ReadOnlyAttribute' => ( default => 30 ); |
7a8e32bc |
147 | |
09f9282e |
148 | class_has 'YetAnotherAttribute' => ( |
149 | is => 'ro', |
150 | default => 'thing', |
151 | ); |
7a4a3b1e |
152 | |
7a8e32bc |
153 | no Moose; |
0f24a39d |
154 | } |
155 | |
09f9282e |
156 | sub run_tests { |
0f24a39d |
157 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
158 | |
159 | { |
09f9282e |
160 | is( |
161 | HasClassAttribute->ObjectCount(), 0, |
162 | 'ObjectCount() is 0' |
163 | ); |
0f24a39d |
164 | |
165 | my $hca1 = HasClassAttribute->new(); |
09f9282e |
166 | is( |
167 | $hca1->size(), 5, |
168 | 'size is 5 - object attribute works as expected' |
169 | ); |
170 | is( |
171 | HasClassAttribute->ObjectCount(), 1, |
172 | 'ObjectCount() is 1' |
173 | ); |
0f24a39d |
174 | |
175 | my $hca2 = HasClassAttribute->new( size => 10 ); |
09f9282e |
176 | is( |
177 | $hca2->size(), 10, |
178 | 'size is 10 - object attribute can be set via constructor' |
179 | ); |
180 | is( |
181 | HasClassAttribute->ObjectCount(), 2, |
182 | 'ObjectCount() is 2' |
183 | ); |
184 | is( |
185 | $hca2->ObjectCount(), 2, |
186 | 'ObjectCount() is 2 - can call class attribute accessor on object' |
187 | ); |
0f24a39d |
188 | } |
189 | |
190 | { |
54a288bd |
191 | my $hca3 = HasClassAttribute->new( ObjectCount => 20 ); |
09f9282e |
192 | is( |
193 | $hca3->ObjectCount(), 3, |
194 | 'class attributes passed to the constructor do not get set in the object' |
195 | ); |
196 | is( |
197 | HasClassAttribute->ObjectCount(), 3, |
198 | 'class attributes are not affected by constructor params' |
199 | ); |
0f24a39d |
200 | } |
201 | |
202 | { |
203 | my $object = bless {}, 'Thing'; |
204 | |
205 | HasClassAttribute->WeakAttribute($object); |
206 | |
6b059c78 |
207 | undef $object; |
208 | |
09f9282e |
209 | ok( |
210 | !defined HasClassAttribute->WeakAttribute(), |
211 | 'weak class attributes are weak' |
212 | ); |
0f24a39d |
213 | } |
54a288bd |
214 | |
215 | { |
09f9282e |
216 | is( |
963254e0 |
217 | $SharedTests::Lazy, 0, |
218 | '$SharedTests::Lazy is 0' |
09f9282e |
219 | ); |
54a288bd |
220 | |
09f9282e |
221 | is( |
222 | HasClassAttribute->LazyAttribute(), 1, |
223 | 'HasClassAttribute->LazyAttribute() is 1' |
224 | ); |
54a288bd |
225 | |
09f9282e |
226 | is( |
963254e0 |
227 | $SharedTests::Lazy, 1, |
228 | '$SharedTests::Lazy is 1 after calling LazyAttribute' |
09f9282e |
229 | ); |
54a288bd |
230 | } |
231 | |
232 | { |
233 | eval { HasClassAttribute->ReadOnlyAttribute(20) }; |
09f9282e |
234 | like( |
235 | $@, qr/\QCannot assign a value to a read-only accessor/, |
236 | 'cannot set read-only class attribute' |
237 | ); |
54a288bd |
238 | } |
239 | |
240 | { |
09f9282e |
241 | is( |
242 | Child->ReadOnlyAttribute(), 30, |
243 | q{Child class can extend parent's class attribute} |
244 | ); |
54a288bd |
245 | } |
246 | |
247 | { |
09f9282e |
248 | ok( |
249 | !HasClassAttribute->HasM(), |
250 | 'HasM() returns false before M is set' |
251 | ); |
54a288bd |
252 | |
253 | HasClassAttribute->SetM(22); |
254 | |
09f9282e |
255 | ok( |
256 | HasClassAttribute->HasM(), |
257 | 'HasM() returns true after M is set' |
258 | ); |
259 | is( |
260 | HasClassAttribute->M(), 22, |
261 | 'M() returns 22' |
262 | ); |
54a288bd |
263 | |
264 | HasClassAttribute->ClearM(); |
265 | |
09f9282e |
266 | ok( |
267 | !HasClassAttribute->HasM(), |
268 | 'HasM() returns false after M is cleared' |
269 | ); |
54a288bd |
270 | } |
271 | |
272 | { |
09f9282e |
273 | isa_ok( |
274 | HasClassAttribute->Delegatee(), 'Delegatee', |
275 | 'has a Delegetee object' |
276 | ); |
277 | is( |
278 | HasClassAttribute->units(), 5, |
279 | 'units() delegates to Delegatee and returns 5' |
280 | ); |
54a288bd |
281 | } |
282 | |
54a288bd |
283 | { |
54a288bd |
284 | my @ids = HasClassAttribute->IdsInMapping(); |
09f9282e |
285 | is( |
286 | scalar @ids, 0, |
287 | 'there are no keys in the mapping yet' |
288 | ); |
54a288bd |
289 | |
09f9282e |
290 | ok( |
291 | !HasClassAttribute->ExistsInMapping('a'), |
292 | 'key does not exist in mapping' |
293 | ); |
54a288bd |
294 | |
295 | HasClassAttribute->SetMapping( a => 20 ); |
296 | |
09f9282e |
297 | ok( |
298 | HasClassAttribute->ExistsInMapping('a'), |
299 | 'key does exist in mapping' |
300 | ); |
54a288bd |
301 | |
09f9282e |
302 | is( |
303 | HasClassAttribute->GetMapping('a'), 20, |
304 | 'value for a in mapping is 20' |
305 | ); |
54a288bd |
306 | } |
6048a053 |
307 | |
308 | { |
09f9282e |
309 | is( |
310 | HasClassAttribute->Built(), 42, |
311 | 'attribute with builder works' |
312 | ); |
6048a053 |
313 | |
09f9282e |
314 | is( |
315 | HasClassAttribute->LazyBuilt(), 42, |
316 | 'attribute with lazy builder works' |
317 | ); |
6048a053 |
318 | } |
8207dfe7 |
319 | |
320 | { |
321 | HasClassAttribute->Triggerish(42); |
322 | is( scalar @HasClassAttribute::Triggered, 1, 'trigger was called' ); |
323 | is( HasClassAttribute->Triggerish(), 42, 'Triggerish is now 42' ); |
324 | |
325 | HasClassAttribute->Triggerish(84); |
326 | is( HasClassAttribute->Triggerish(), 84, 'Triggerish is now 84' ); |
327 | |
09f9282e |
328 | is_deeply( |
329 | \@HasClassAttribute::Triggered, |
330 | [ |
331 | [qw( HasClassAttribute 42 )], |
332 | [qw( HasClassAttribute 84 42 )], |
333 | ], |
334 | 'trigger passes old value correctly' |
335 | ); |
8207dfe7 |
336 | } |
ee29de7b |
337 | |
338 | done_testing(); |
0f24a39d |
339 | } |
340 | |
0f24a39d |
341 | 1; |