6 use Scalar::Util qw( isweak );
12 if ( eval 'use MooseX::AttributeHelpers; 1;' )
22 package HasClassAttribute;
25 use MooseX::ClassAttribute;
30 class_has 'ObjectCount' =>
36 class_has 'WeakAttribute' =>
42 class_has 'LazyAttribute' =>
46 # The side effect is used to test that this was called
48 default => sub { $Lazy = 1 },
51 class_has 'ReadOnlyAttribute' =>
57 class_has 'ManyNames' =>
66 class_has 'Delegatee' =>
69 handles => [ 'units', 'color' ],
70 default => sub { Delegatee->new() },
75 class_has 'Mapping' =>
76 ( metaclass => 'Collection::Hash',
78 isa => 'HashRef[Str]',
79 default => sub { {} },
81 { exists => 'ExistsInMapping',
82 keys => 'IdsInMapping',
96 no MooseX::ClassAttribute;
102 $self->ObjectCount( $self->ObjectCount() + 1 );
109 $class->meta()->make_immutable();
110 MooseX::ClassAttribute::container_class()->meta()->make_immutable();
111 Delegatee->meta()->make_immutable();
135 use MooseX::ClassAttribute;
137 extends 'HasClassAttribute';
139 class_has '+ReadOnlyAttribute' =>
145 local $Test::Builder::Level = $Test::Builder::Level + 1;
148 is( HasClassAttribute->ObjectCount(), 0,
149 'ObjectCount() is 0' );
151 my $hca1 = HasClassAttribute->new();
152 is( $hca1->size(), 5,
153 'size is 5 - object attribute works as expected' );
154 is( HasClassAttribute->ObjectCount(), 1,
155 'ObjectCount() is 1' );
157 my $hca2 = HasClassAttribute->new( size => 10 );
158 is( $hca2->size(), 10,
159 'size is 10 - object attribute can be set via constructor' );
160 is( HasClassAttribute->ObjectCount(), 2,
161 'ObjectCount() is 2' );
162 is( $hca2->ObjectCount(), 2,
163 'ObjectCount() is 2 - can call class attribute accessor on object' );
167 my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
168 is( $hca3->ObjectCount(), 3,
169 'class attributes passed to the constructor do not get set in the object' );
170 is( HasClassAttribute->ObjectCount(), 3,
171 'class attributes are not affected by constructor params' );
175 my $object = bless {}, 'Thing';
177 HasClassAttribute->WeakAttribute($object);
181 ok( ! defined HasClassAttribute->WeakAttribute(),
182 'weak class attributes are weak' );
186 is( $HasClassAttribute::Lazy, 0,
187 '$HasClassAttribute::Lazy is 0' );
189 is( HasClassAttribute->LazyAttribute(), 1,
190 'HasClassAttribute->LazyAttribute() is 1' );
192 is( $HasClassAttribute::Lazy, 1,
193 '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' );
197 eval { HasClassAttribute->ReadOnlyAttribute(20) };
198 like( $@, qr/\QCannot assign a value to a read-only accessor/,
199 'cannot set read-only class attribute' );
203 is( Child->ReadOnlyAttribute(), 30,
204 q{Child class can extend parent's class attribute} );
208 ok( ! HasClassAttribute->HasM(),
209 'HasM() returns false before M is set' );
211 HasClassAttribute->SetM(22);
213 ok( HasClassAttribute->HasM(),
214 'HasM() returns true after M is set' );
215 is( HasClassAttribute->M(), 22,
218 HasClassAttribute->ClearM();
220 ok( ! HasClassAttribute->HasM(),
221 'HasM() returns false after M is cleared' );
225 isa_ok( HasClassAttribute->Delegatee(), 'Delegatee',
226 'has a Delegetee object' );
227 is( HasClassAttribute->units(), 5,
228 'units() delegates to Delegatee and returns 5' );
232 ok( ! HasClassAttribute->can('class_has'),
233 q{'no MooseX::ClassAttribute' remove class_has from HasClassAttribute} );
238 skip 'These tests require MooseX::AttributeHelpers', 4
241 my @ids = HasClassAttribute->IdsInMapping();
243 'there are no keys in the mapping yet' );
245 ok( ! HasClassAttribute->ExistsInMapping('a'),
246 'key does not exist in mapping' );
248 HasClassAttribute->SetMapping( a => 20 );
250 ok( HasClassAttribute->ExistsInMapping('a'),
251 'key does exist in mapping' );
253 is( HasClassAttribute->GetMapping('a'), 20,
254 'value for a in mapping is 20' );