6 use Scalar::Util qw( isweak );
27 # The side effect is used to test that this was called
29 default => sub { $Lazy = 1 },
31 ReadOnlyAttribute => {
47 handles => [ 'units', 'color' ],
48 # if it's not lazy it makes a new object before we define
49 # Delegatee's attributes.
51 default => sub { Delegatee->new() },
56 isa => 'HashRef[Str]',
57 default => sub { {} },
59 'ExistsInMapping' => 'exists',
60 'IdsInMapping' => 'keys',
61 'GetMapping' => 'get',
62 'SetMapping' => 'set',
67 builder => '_BuildIt',
72 builder => '_BuildIt',
76 trigger => sub { shift->_CallTrigger(@_) },
81 package HasClassAttribute;
84 use MooseX::ClassAttribute;
86 while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
87 class_has $name => %{$def};
101 $self->ObjectCount( $self->ObjectCount() + 1 );
109 push @Triggered, [@_];
115 $class->meta()->make_immutable();
116 Delegatee->meta()->make_immutable();
142 use MooseX::ClassAttribute;
144 extends 'HasClassAttribute';
146 class_has '+ReadOnlyAttribute' => ( default => 30 );
148 class_has 'YetAnotherAttribute' => (
157 local $Test::Builder::Level = $Test::Builder::Level + 1;
161 HasClassAttribute->ObjectCount(), 0,
165 my $hca1 = HasClassAttribute->new();
168 'size is 5 - object attribute works as expected'
171 HasClassAttribute->ObjectCount(), 1,
175 my $hca2 = HasClassAttribute->new( size => 10 );
178 'size is 10 - object attribute can be set via constructor'
181 HasClassAttribute->ObjectCount(), 2,
185 $hca2->ObjectCount(), 2,
186 'ObjectCount() is 2 - can call class attribute accessor on object'
191 my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
193 $hca3->ObjectCount(), 3,
194 'class attributes passed to the constructor do not get set in the object'
197 HasClassAttribute->ObjectCount(), 3,
198 'class attributes are not affected by constructor params'
203 my $object = bless {}, 'Thing';
205 HasClassAttribute->WeakAttribute($object);
210 !defined HasClassAttribute->WeakAttribute(),
211 'weak class attributes are weak'
217 $SharedTests::Lazy, 0,
218 '$SharedTests::Lazy is 0'
222 HasClassAttribute->LazyAttribute(), 1,
223 'HasClassAttribute->LazyAttribute() is 1'
227 $SharedTests::Lazy, 1,
228 '$SharedTests::Lazy is 1 after calling LazyAttribute'
233 eval { HasClassAttribute->ReadOnlyAttribute(20) };
235 $@, qr/\QCannot assign a value to a read-only accessor/,
236 'cannot set read-only class attribute'
242 Child->ReadOnlyAttribute(), 30,
243 q{Child class can extend parent's class attribute}
249 !HasClassAttribute->HasM(),
250 'HasM() returns false before M is set'
253 HasClassAttribute->SetM(22);
256 HasClassAttribute->HasM(),
257 'HasM() returns true after M is set'
260 HasClassAttribute->M(), 22,
264 HasClassAttribute->ClearM();
267 !HasClassAttribute->HasM(),
268 'HasM() returns false after M is cleared'
274 HasClassAttribute->Delegatee(), 'Delegatee',
275 'has a Delegetee object'
278 HasClassAttribute->units(), 5,
279 'units() delegates to Delegatee and returns 5'
284 my @ids = HasClassAttribute->IdsInMapping();
287 'there are no keys in the mapping yet'
291 !HasClassAttribute->ExistsInMapping('a'),
292 'key does not exist in mapping'
295 HasClassAttribute->SetMapping( a => 20 );
298 HasClassAttribute->ExistsInMapping('a'),
299 'key does exist in mapping'
303 HasClassAttribute->GetMapping('a'), 20,
304 'value for a in mapping is 20'
310 HasClassAttribute->Built(), 42,
311 'attribute with builder works'
315 HasClassAttribute->LazyBuilt(), 42,
316 'attribute with lazy builder works'
321 HasClassAttribute->Triggerish(42);
322 is( scalar @HasClassAttribute::Triggered, 1, 'trigger was called' );
323 is( HasClassAttribute->Triggerish(), 42, 'Triggerish is now 42' );
325 HasClassAttribute->Triggerish(84);
326 is( HasClassAttribute->Triggerish(), 84, 'Triggerish is now 84' );
329 \@HasClassAttribute::Triggered,
331 [qw( HasClassAttribute 42 )],
332 [qw( HasClassAttribute 84 42 )],
334 'trigger passes old value correctly'