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