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' ],
49 # if it's not lazy it makes a new object before we define
50 # Delegatee's attributes.
52 default => sub { Delegatee->new() },
57 isa => 'HashRef[Str]',
58 default => sub { {} },
60 'ExistsInMapping' => 'exists',
61 'IdsInMapping' => 'keys',
62 'GetMapping' => 'get',
63 'SetMapping' => 'set',
68 builder => '_BuildIt',
73 builder => '_BuildIt',
77 trigger => sub { shift->_CallTrigger(@_) },
81 default => sub { [] },
86 package HasClassAttribute;
89 use MooseX::ClassAttribute;
91 while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
92 class_has $name => %{$def};
106 $self->ObjectCount( $self->ObjectCount() + 1 );
112 push @{ $_[0]->TriggerRecord() }, [@_];
118 $class->meta()->make_immutable();
119 Delegatee->meta()->make_immutable();
145 use MooseX::ClassAttribute;
147 extends 'HasClassAttribute';
149 class_has '+ReadOnlyAttribute' => ( default => 30 );
151 class_has 'YetAnotherAttribute' => (
160 my $thing = shift || 'HasClassAttribute';
162 local $Test::Builder::Level = $Test::Builder::Level + 1;
166 my $count = ref $thing ? 1 : 0;
170 $thing->ObjectCount(), $count,
174 unless ( ref $thing ) {
175 my $hca1 = $thing->new();
178 'size is 5 - object attribute works as expected'
181 $thing->ObjectCount(), 1,
185 my $hca2 = $thing->new( size => 10 );
188 'size is 10 - object attribute can be set via constructor'
191 $thing->ObjectCount(), 2,
195 $hca2->ObjectCount(), 2,
196 'ObjectCount() is 2 - can call class attribute accessor on object'
201 unless ( ref $thing ) {
202 my $hca3 = $thing->new( ObjectCount => 20 );
204 $hca3->ObjectCount(), 3,
205 'class attributes passed to the constructor do not get set in the object'
208 $thing->ObjectCount(), 3,
209 'class attributes are not affected by constructor params'
214 my $object = bless {}, 'Thing';
216 $thing->WeakAttribute($object);
221 !defined $thing->WeakAttribute(),
222 'weak class attributes are weak'
228 $SharedTests::Lazy, 0,
229 '$SharedTests::Lazy is 0'
233 $thing->LazyAttribute(), 1,
234 '$thing->LazyAttribute() is 1'
238 $SharedTests::Lazy, 1,
239 '$SharedTests::Lazy is 1 after calling LazyAttribute'
244 eval { $thing->ReadOnlyAttribute(20) };
246 $@, qr/\QCannot assign a value to a read-only accessor/,
247 'cannot set read-only class attribute'
253 Child->ReadOnlyAttribute(), 30,
254 q{Child class can extend parent's class attribute}
261 'HasM() returns false before M is set'
268 'HasM() returns true after M is set'
279 'HasM() returns false after M is cleared'
285 $thing->Delegatee(), 'Delegatee',
286 'has a Delegetee object'
290 'units() delegates to Delegatee and returns 5'
295 my @ids = $thing->IdsInMapping();
298 'there are no keys in the mapping yet'
302 !$thing->ExistsInMapping('a'),
303 'key does not exist in mapping'
306 $thing->SetMapping( a => 20 );
309 $thing->ExistsInMapping('a'),
310 'key does exist in mapping'
314 $thing->GetMapping('a'), 20,
315 'value for a in mapping is 20'
322 'attribute with builder works'
326 $thing->LazyBuilt(), 42,
327 'attribute with lazy builder works'
332 $thing->Triggerish(42);
334 is( scalar @{ $thing->TriggerRecord() }, 1, 'trigger was called' );
335 is( $thing->Triggerish(), 42, 'Triggerish is now 42' );
337 $thing->Triggerish(84);
338 is( $thing->Triggerish(), 84, 'Triggerish is now 84' );
341 $thing->TriggerRecord(),
343 [ $thing, qw( 42 ) ],
344 [ $thing, qw( 84 42 ) ],
346 'trigger passes old value correctly'