6 use Scalar::Util qw( isweak );
26 # The side effect is used to test that this was called
28 default => sub { $Lazy = 1 },
30 ReadOnlyAttribute => {
46 handles => [ 'units', 'color' ],
47 # if it's not lazy it makes a new object before we define
48 # Delegatee's attributes.
50 default => sub { Delegatee->new() },
55 isa => 'HashRef[Str]',
56 default => sub { {} },
58 'ExistsInMapping' => 'exists',
59 'IdsInMapping' => 'keys',
60 'GetMapping' => 'get',
61 'SetMapping' => 'set',
66 builder => '_BuildIt',
71 builder => '_BuildIt',
75 trigger => sub { shift->_CallTrigger(@_) },
79 default => sub { [] },
84 package HasClassAttribute;
87 use MooseX::ClassAttribute;
89 while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
90 class_has $name => %{$def};
104 $self->ObjectCount( $self->ObjectCount() + 1 );
110 push @{ $_[0]->TriggerRecord() }, [@_];
116 $class->meta()->make_immutable();
117 Delegatee->meta()->make_immutable();
143 use MooseX::ClassAttribute;
145 extends 'HasClassAttribute';
147 class_has '+ReadOnlyAttribute' => ( default => 30 );
149 class_has 'YetAnotherAttribute' => (
158 my $thing = shift || 'HasClassAttribute';
160 local $Test::Builder::Level = $Test::Builder::Level + 1;
164 my $count = ref $thing ? 1 : 0;
168 $thing->ObjectCount(), $count,
172 unless ( ref $thing ) {
173 my $hca1 = $thing->new();
176 'size is 5 - object attribute works as expected'
179 $thing->ObjectCount(), 1,
183 my $hca2 = $thing->new( size => 10 );
186 'size is 10 - object attribute can be set via constructor'
189 $thing->ObjectCount(), 2,
193 $hca2->ObjectCount(), 2,
194 'ObjectCount() is 2 - can call class attribute accessor on object'
199 unless ( ref $thing ) {
200 my $hca3 = $thing->new( ObjectCount => 20 );
202 $hca3->ObjectCount(), 3,
203 'class attributes passed to the constructor do not get set in the object'
206 $thing->ObjectCount(), 3,
207 'class attributes are not affected by constructor params'
212 my $object = bless {}, 'Thing';
214 $thing->WeakAttribute($object);
219 !defined $thing->WeakAttribute(),
220 'weak class attributes are weak'
226 $SharedTests::Lazy, 0,
227 '$SharedTests::Lazy is 0'
231 $thing->LazyAttribute(), 1,
232 '$thing->LazyAttribute() is 1'
236 $SharedTests::Lazy, 1,
237 '$SharedTests::Lazy is 1 after calling LazyAttribute'
242 eval { $thing->ReadOnlyAttribute(20) };
244 $@, qr/\QCannot assign a value to a read-only accessor/,
245 'cannot set read-only class attribute'
251 Child->ReadOnlyAttribute(), 30,
252 q{Child class can extend parent's class attribute}
259 'HasM() returns false before M is set'
266 'HasM() returns true after M is set'
277 'HasM() returns false after M is cleared'
283 $thing->Delegatee(), 'Delegatee',
284 'has a Delegetee object'
288 'units() delegates to Delegatee and returns 5'
293 my @ids = $thing->IdsInMapping();
296 'there are no keys in the mapping yet'
300 !$thing->ExistsInMapping('a'),
301 'key does not exist in mapping'
304 $thing->SetMapping( a => 20 );
307 $thing->ExistsInMapping('a'),
308 'key does exist in mapping'
312 $thing->GetMapping('a'), 20,
313 'value for a in mapping is 20'
320 'attribute with builder works'
324 $thing->LazyBuilt(), 42,
325 'attribute with lazy builder works'
330 $thing->Triggerish(42);
332 is( scalar @{ $thing->TriggerRecord() }, 1, 'trigger was called' );
333 is( $thing->Triggerish(), 42, 'Triggerish is now 42' );
335 $thing->Triggerish(84);
336 is( $thing->Triggerish(), 84, 'Triggerish is now 84' );
339 $thing->TriggerRecord(),
341 [ $thing, qw( 42 ) ],
342 [ $thing, qw( 84 42 ) ],
344 'trigger passes old value correctly'