Make MX::AH optional
[gitmo/MooseX-ClassAttribute.git] / t / lib / SharedTests.pm
CommitLineData
0f24a39d 1package SharedTests;
2
3use strict;
4use warnings;
5
6use Scalar::Util qw( isweak );
54a288bd 7use 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
164sub 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
2961;