X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FSharedTests.pm;h=8683db2d0d6f07604e8e4e4a9202b9b5da7e4806;hb=3e9e5aef1aa4a05b64d7beddc49121775bec5320;hp=3c83beeaf3095e9001a73d182f47ea71c1a9c9d1;hpb=09f9282e4b42b0dfe654f7fcf34ea1a3772816ce;p=gitmo%2FMooseX-ClassAttribute.git diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm index 3c83bee..8683db2 100644 --- a/t/lib/SharedTests.pm +++ b/t/lib/SharedTests.pm @@ -6,29 +6,20 @@ use warnings; 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, @@ -36,24 +27,21 @@ use Test::More; # 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' ], @@ -62,36 +50,47 @@ use Test::More; # 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', @@ -107,12 +106,10 @@ use Test::More; $self->ObjectCount( $self->ObjectCount() + 1 ); } - sub _BuildIt {42} - - our @Triggered; + sub _BuildIt { 42 } sub _CallTrigger { - push @Triggered, [@_]; + push @{ $_[0]->TriggerRecord() }, [@_]; } sub make_immutable { @@ -160,49 +157,55 @@ use Test::More; } 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' ); } @@ -210,35 +213,35 @@ sub run_tests { { 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' @@ -254,90 +257,91 @@ sub run_tests { { 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' );