use Scalar::Util qw( isweak );
use Test::More;
-{
- package HasClassAttribute;
-
- use Moose qw( has );
- use MooseX::ClassAttribute;
- use MooseX::AttributeHelpers;
-
- use vars qw($Lazy);
- $Lazy = 0;
+use vars qw($Lazy);
- class_has 'ObjectCount' => (
+our %Attrs = (
+ ObjectCount => {
is => 'rw',
isa => 'Int',
default => 0,
- );
-
- class_has 'WeakAttribute' => (
+ },
+ WeakAttribute => {
is => 'rw',
isa => 'Object',
weak_ref => 1,
- );
-
- class_has 'LazyAttribute' => (
+ },
+ LazyAttribute => {
is => 'rw',
isa => 'Int',
lazy => 1,
# The side effect is used to test that this was called
# lazily.
default => sub { $Lazy = 1 },
- );
-
- class_has 'ReadOnlyAttribute' => (
+ },
+ ReadOnlyAttribute => {
is => 'ro',
isa => 'Int',
default => 10,
- );
-
- class_has 'ManyNames' => (
+ },
+ ManyNames => {
is => 'rw',
isa => 'Int',
reader => 'M',
writer => 'SetM',
clearer => 'ClearM',
predicate => 'HasM',
- );
-
- class_has 'Delegatee' => (
+ },
+ Delegatee => {
is => 'rw',
isa => 'Delegatee',
handles => [ 'units', 'color' ],
# Delegatee's attributes.
lazy => 1,
default => sub { Delegatee->new() },
- );
-
- class_has 'Mapping' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => 'HashRef[Str]',
- default => sub { {} },
- provides => {
- exists => 'ExistsInMapping',
- keys => 'IdsInMapping',
- get => 'GetMapping',
- set => 'SetMapping',
+ },
+ Mapping => {
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ 'ExistsInMapping' => 'exists',
+ 'IdsInMapping' => 'keys',
+ 'GetMapping' => 'get',
+ 'SetMapping' => 'set',
},
- );
-
- class_has 'Built' => (
+ },
+ Built => {
is => 'ro',
builder => '_BuildIt',
- );
-
- class_has 'LazyBuilt' => (
+ },
+ LazyBuilt => {
is => 'ro',
lazy => 1,
builder => '_BuildIt',
- );
-
- class_has 'Triggerish' => (
+ },
+ Triggerish => {
is => 'rw',
trigger => sub { shift->_CallTrigger(@_) },
- );
+ },
+ TriggerRecord => {
+ is => 'ro',
+ default => sub { [] },
+ },
+);
+
+{
+ package HasClassAttribute;
+
+ use Moose qw( has );
+ use MooseX::ClassAttribute;
+
+ while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
+ class_has $name => %{$def};
+ }
has 'size' => (
is => 'rw',
$self->ObjectCount( $self->ObjectCount() + 1 );
}
- sub _BuildIt {42}
-
- our @Triggered;
+ sub _BuildIt { 42 }
sub _CallTrigger {
- push @Triggered, [@_];
+ push @{ $_[0]->TriggerRecord() }, [@_];
}
sub make_immutable {
}
sub run_tests {
- plan tests => 30;
+ my $thing = shift || 'HasClassAttribute';
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ $Lazy = 0;
+
+ my $count = ref $thing ? 1 : 0;
+
{
is(
- HasClassAttribute->ObjectCount(), 0,
+ $thing->ObjectCount(), $count,
'ObjectCount() is 0'
);
- my $hca1 = HasClassAttribute->new();
- is(
- $hca1->size(), 5,
- 'size is 5 - object attribute works as expected'
- );
- is(
- HasClassAttribute->ObjectCount(), 1,
- 'ObjectCount() is 1'
- );
-
- my $hca2 = HasClassAttribute->new( size => 10 );
- is(
- $hca2->size(), 10,
- 'size is 10 - object attribute can be set via constructor'
- );
- is(
- HasClassAttribute->ObjectCount(), 2,
- 'ObjectCount() is 2'
- );
- is(
- $hca2->ObjectCount(), 2,
- 'ObjectCount() is 2 - can call class attribute accessor on object'
- );
+ unless ( ref $thing ) {
+ my $hca1 = $thing->new();
+ is(
+ $hca1->size(), 5,
+ 'size is 5 - object attribute works as expected'
+ );
+ is(
+ $thing->ObjectCount(), 1,
+ 'ObjectCount() is 1'
+ );
+
+ my $hca2 = $thing->new( size => 10 );
+ is(
+ $hca2->size(), 10,
+ 'size is 10 - object attribute can be set via constructor'
+ );
+ is(
+ $thing->ObjectCount(), 2,
+ 'ObjectCount() is 2'
+ );
+ is(
+ $hca2->ObjectCount(), 2,
+ 'ObjectCount() is 2 - can call class attribute accessor on object'
+ );
+ }
}
- {
- my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
+ unless ( ref $thing ) {
+ my $hca3 = $thing->new( ObjectCount => 20 );
is(
$hca3->ObjectCount(), 3,
'class attributes passed to the constructor do not get set in the object'
);
is(
- HasClassAttribute->ObjectCount(), 3,
+ $thing->ObjectCount(), 3,
'class attributes are not affected by constructor params'
);
}
{
my $object = bless {}, 'Thing';
- HasClassAttribute->WeakAttribute($object);
+ $thing->WeakAttribute($object);
undef $object;
ok(
- !defined HasClassAttribute->WeakAttribute(),
+ !defined $thing->WeakAttribute(),
'weak class attributes are weak'
);
}
{
is(
- $HasClassAttribute::Lazy, 0,
- '$HasClassAttribute::Lazy is 0'
+ $SharedTests::Lazy, 0,
+ '$SharedTests::Lazy is 0'
);
is(
- HasClassAttribute->LazyAttribute(), 1,
- 'HasClassAttribute->LazyAttribute() is 1'
+ $thing->LazyAttribute(), 1,
+ '$thing->LazyAttribute() is 1'
);
is(
- $HasClassAttribute::Lazy, 1,
- '$HasClassAttribute::Lazy is 1 after calling LazyAttribute'
+ $SharedTests::Lazy, 1,
+ '$SharedTests::Lazy is 1 after calling LazyAttribute'
);
}
{
- eval { HasClassAttribute->ReadOnlyAttribute(20) };
+ eval { $thing->ReadOnlyAttribute(20) };
like(
$@, qr/\QCannot assign a value to a read-only accessor/,
'cannot set read-only class attribute'
{
ok(
- !HasClassAttribute->HasM(),
+ !$thing->HasM(),
'HasM() returns false before M is set'
);
- HasClassAttribute->SetM(22);
+ $thing->SetM(22);
ok(
- HasClassAttribute->HasM(),
+ $thing->HasM(),
'HasM() returns true after M is set'
);
is(
- HasClassAttribute->M(), 22,
+ $thing->M(), 22,
'M() returns 22'
);
- HasClassAttribute->ClearM();
+ $thing->ClearM();
ok(
- !HasClassAttribute->HasM(),
+ !$thing->HasM(),
'HasM() returns false after M is cleared'
);
}
{
isa_ok(
- HasClassAttribute->Delegatee(), 'Delegatee',
+ $thing->Delegatee(), 'Delegatee',
'has a Delegetee object'
);
is(
- HasClassAttribute->units(), 5,
+ $thing->units(), 5,
'units() delegates to Delegatee and returns 5'
);
}
{
- my @ids = HasClassAttribute->IdsInMapping();
+ my @ids = $thing->IdsInMapping();
is(
scalar @ids, 0,
'there are no keys in the mapping yet'
);
ok(
- !HasClassAttribute->ExistsInMapping('a'),
+ !$thing->ExistsInMapping('a'),
'key does not exist in mapping'
);
- HasClassAttribute->SetMapping( a => 20 );
+ $thing->SetMapping( a => 20 );
ok(
- HasClassAttribute->ExistsInMapping('a'),
+ $thing->ExistsInMapping('a'),
'key does exist in mapping'
);
is(
- HasClassAttribute->GetMapping('a'), 20,
+ $thing->GetMapping('a'), 20,
'value for a in mapping is 20'
);
}
{
is(
- HasClassAttribute->Built(), 42,
+ $thing->Built(), 42,
'attribute with builder works'
);
is(
- HasClassAttribute->LazyBuilt(), 42,
+ $thing->LazyBuilt(), 42,
'attribute with lazy builder works'
);
}
{
- HasClassAttribute->Triggerish(42);
- is( scalar @HasClassAttribute::Triggered, 1, 'trigger was called' );
- is( HasClassAttribute->Triggerish(), 42, 'Triggerish is now 42' );
+ $thing->Triggerish(42);
+
+ is( scalar @{ $thing->TriggerRecord() }, 1, 'trigger was called' );
+ is( $thing->Triggerish(), 42, 'Triggerish is now 42' );
- HasClassAttribute->Triggerish(84);
- is( HasClassAttribute->Triggerish(), 84, 'Triggerish is now 84' );
+ $thing->Triggerish(84);
+ is( $thing->Triggerish(), 84, 'Triggerish is now 84' );
is_deeply(
- \@HasClassAttribute::Triggered,
+ $thing->TriggerRecord(),
[
- [qw( HasClassAttribute 42 )],
- [qw( HasClassAttribute 84 42 )],
+ [ $thing, qw( 42 ) ],
+ [ $thing, qw( 84 42 ) ],
],
'trigger passes old value correctly'
);
projects / gitmo/MooseX-ClassAttribute.git / blobdiff