6 use Scalar::Util qw( isweak );
12 if ( eval 'use MooseX::AttributeHelpers 0.13; 1;' )
18 sub HasMXAH { $HasMXAH }
21 package HasClassAttribute;
24 use MooseX::ClassAttribute;
29 class_has 'ObjectCount' =>
35 class_has 'WeakAttribute' =>
41 class_has 'LazyAttribute' =>
45 # The side effect is used to test that this was called
47 default => sub { $Lazy = 1 },
50 class_has 'ReadOnlyAttribute' =>
56 class_has 'ManyNames' =>
65 class_has 'Delegatee' =>
68 handles => [ 'units', 'color' ],
69 # if it's not lazy it makes a new object before we define
70 # Delegatee's attributes.
72 default => sub { Delegatee->new() },
75 if ( SharedTests->HasMXAH() )
77 class_has 'Mapping' =>
78 ( metaclass => 'Collection::Hash',
80 isa => 'HashRef[Str]',
81 default => sub { {} },
83 { exists => 'ExistsInMapping',
84 keys => 'IdsInMapping',
103 $self->ObjectCount( $self->ObjectCount() + 1 );
110 $class->meta()->make_immutable();
111 Delegatee->meta()->make_immutable();
137 use MooseX::ClassAttribute;
139 extends 'HasClassAttribute';
141 class_has '+ReadOnlyAttribute' =>
144 class_has 'YetAnotherAttribute' =>
156 local $Test::Builder::Level = $Test::Builder::Level + 1;
159 is( HasClassAttribute->ObjectCount(), 0,
160 'ObjectCount() is 0' );
162 my $hca1 = HasClassAttribute->new();
163 is( $hca1->size(), 5,
164 'size is 5 - object attribute works as expected' );
165 is( HasClassAttribute->ObjectCount(), 1,
166 'ObjectCount() is 1' );
168 my $hca2 = HasClassAttribute->new( size => 10 );
169 is( $hca2->size(), 10,
170 'size is 10 - object attribute can be set via constructor' );
171 is( HasClassAttribute->ObjectCount(), 2,
172 'ObjectCount() is 2' );
173 is( $hca2->ObjectCount(), 2,
174 'ObjectCount() is 2 - can call class attribute accessor on object' );
178 my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
179 is( $hca3->ObjectCount(), 3,
180 'class attributes passed to the constructor do not get set in the object' );
181 is( HasClassAttribute->ObjectCount(), 3,
182 'class attributes are not affected by constructor params' );
186 my $object = bless {}, 'Thing';
188 HasClassAttribute->WeakAttribute($object);
192 ok( ! defined HasClassAttribute->WeakAttribute(),
193 'weak class attributes are weak' );
197 is( $HasClassAttribute::Lazy, 0,
198 '$HasClassAttribute::Lazy is 0' );
200 is( HasClassAttribute->LazyAttribute(), 1,
201 'HasClassAttribute->LazyAttribute() is 1' );
203 is( $HasClassAttribute::Lazy, 1,
204 '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' );
208 eval { HasClassAttribute->ReadOnlyAttribute(20) };
209 like( $@, qr/\QCannot assign a value to a read-only accessor/,
210 'cannot set read-only class attribute' );
214 is( Child->ReadOnlyAttribute(), 30,
215 q{Child class can extend parent's class attribute} );
219 ok( ! HasClassAttribute->HasM(),
220 'HasM() returns false before M is set' );
222 HasClassAttribute->SetM(22);
224 ok( HasClassAttribute->HasM(),
225 'HasM() returns true after M is set' );
226 is( HasClassAttribute->M(), 22,
229 HasClassAttribute->ClearM();
231 ok( ! HasClassAttribute->HasM(),
232 'HasM() returns false after M is cleared' );
236 isa_ok( HasClassAttribute->Delegatee(), 'Delegatee',
237 'has a Delegetee object' );
238 is( HasClassAttribute->units(), 5,
239 'units() delegates to Delegatee and returns 5' );
244 skip 'These tests require MooseX::AttributeHelpers', 4
245 unless SharedTests->HasMXAH();
247 my @ids = HasClassAttribute->IdsInMapping();
249 'there are no keys in the mapping yet' );
251 ok( ! HasClassAttribute->ExistsInMapping('a'),
252 'key does not exist in mapping' );
254 HasClassAttribute->SetMapping( a => 20 );
256 ok( HasClassAttribute->ExistsInMapping('a'),
257 'key does exist in mapping' );
259 is( HasClassAttribute->GetMapping('a'), 20,
260 'value for a in mapping is 20' );