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