X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FSharedTests.pm;h=efedc60ca6a5aec11adfc7f20aab885ca925ddf4;hb=ee29de7b83532784ecf67a6a72579f49855b281e;hp=430fb1ff5abffe5b21c9e57696ee5ed6a81fbef1;hpb=6b059c7811f9345c89ea07c4ebb63ad6310d7932;p=gitmo%2FMooseX-ClassAttribute.git diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm index 430fb1f..efedc60 100644 --- a/t/lib/SharedTests.pm +++ b/t/lib/SharedTests.pm @@ -4,72 +4,205 @@ use strict; use warnings; use Scalar::Util qw( isweak ); -use Test::More tests => 9; - +use Test::More; { package HasClassAttribute; - use Moose; + use Moose qw( has ); use MooseX::ClassAttribute; + use MooseX::AttributeHelpers; - has 'ObjectCount' => - ( metaclass => 'ClassAttribute', - is => 'rw', - isa => 'Int', - default => 0, - ); + use vars qw($Lazy); + $Lazy = 0; - has 'WeakAttribute' => - ( metaclass => 'ClassAttribute', - is => 'rw', - isa => 'Object', - weak_ref => 1, - ); + class_has 'ObjectCount' => ( + is => 'rw', + isa => 'Int', + default => 0, + ); - has 'size' => - ( is => 'rw', - isa => 'Int', - default => 5, - ); + class_has 'WeakAttribute' => ( + is => 'rw', + isa => 'Object', + weak_ref => 1, + ); - sub BUILD - { + class_has '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' => ( + is => 'ro', + isa => 'Int', + default => 10, + ); + + class_has 'ManyNames' => ( + is => 'rw', + isa => 'Int', + reader => 'M', + writer => 'SetM', + clearer => 'ClearM', + predicate => 'HasM', + ); + + class_has 'Delegatee' => ( + is => 'rw', + isa => 'Delegatee', + handles => [ 'units', 'color' ], + + # if it's not lazy it makes a new object before we define + # 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', + }, + ); + + class_has 'Built' => ( + is => 'ro', + builder => '_BuildIt', + ); + + class_has 'LazyBuilt' => ( + is => 'ro', + lazy => 1, + builder => '_BuildIt', + ); + + class_has 'Triggerish' => ( + is => 'rw', + trigger => sub { shift->_CallTrigger(@_) }, + ); + + has 'size' => ( + is => 'rw', + isa => 'Int', + default => 5, + ); + + no Moose; + + sub BUILD { my $self = shift; $self->ObjectCount( $self->ObjectCount() + 1 ); } + + sub _BuildIt {42} + + our @Triggered; + + sub _CallTrigger { + push @Triggered, [@_]; + } + + sub make_immutable { + my $class = shift; + + $class->meta()->make_immutable(); + Delegatee->meta()->make_immutable(); + } +} + +{ + package Delegatee; + + use Moose; + + has 'units' => ( + is => 'ro', + default => 5, + ); + + has 'color' => ( + is => 'ro', + default => 'blue', + ); + + no Moose; } -sub run_tests { + package Child; + + use Moose; + use MooseX::ClassAttribute; + + extends 'HasClassAttribute'; + + class_has '+ReadOnlyAttribute' => ( default => 30 ); + + class_has 'YetAnotherAttribute' => ( + is => 'ro', + default => 'thing', + ); + + no Moose; +} + +sub run_tests { local $Test::Builder::Level = $Test::Builder::Level + 1; { - is( HasClassAttribute->ObjectCount(), 0, - 'ObjectCount() is 0' ); + is( + HasClassAttribute->ObjectCount(), 0, + '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' ); + 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' ); + 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' + ); } { - eval { HasClassAttribute->new( ObjectCount => 20 ) }; - like( $@, qr/\QCannot set a class attribute via the constructor (ObjectCount)/, - 'passing a class attribute to the constructor throws an error' ); - is( HasClassAttribute->ObjectCount(), 2, - 'class attributes are not affected by constructor params' ); + my $hca3 = HasClassAttribute->new( ObjectCount => 20 ); + is( + $hca3->ObjectCount(), 3, + 'class attributes passed to the constructor do not get set in the object' + ); + is( + HasClassAttribute->ObjectCount(), 3, + 'class attributes are not affected by constructor params' + ); } { @@ -79,10 +212,136 @@ sub run_tests undef $object; - ok( ! defined HasClassAttribute->WeakAttribute(), - 'weak class attributes are weak' ); + ok( + !defined HasClassAttribute->WeakAttribute(), + 'weak class attributes are weak' + ); + } + + { + is( + $HasClassAttribute::Lazy, 0, + '$HasClassAttribute::Lazy is 0' + ); + + is( + HasClassAttribute->LazyAttribute(), 1, + 'HasClassAttribute->LazyAttribute() is 1' + ); + + is( + $HasClassAttribute::Lazy, 1, + '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' + ); + } + + { + eval { HasClassAttribute->ReadOnlyAttribute(20) }; + like( + $@, qr/\QCannot assign a value to a read-only accessor/, + 'cannot set read-only class attribute' + ); + } + + { + is( + Child->ReadOnlyAttribute(), 30, + q{Child class can extend parent's class attribute} + ); + } + + { + ok( + !HasClassAttribute->HasM(), + 'HasM() returns false before M is set' + ); + + HasClassAttribute->SetM(22); + + ok( + HasClassAttribute->HasM(), + 'HasM() returns true after M is set' + ); + is( + HasClassAttribute->M(), 22, + 'M() returns 22' + ); + + HasClassAttribute->ClearM(); + + ok( + !HasClassAttribute->HasM(), + 'HasM() returns false after M is cleared' + ); + } + + { + isa_ok( + HasClassAttribute->Delegatee(), 'Delegatee', + 'has a Delegetee object' + ); + is( + HasClassAttribute->units(), 5, + 'units() delegates to Delegatee and returns 5' + ); + } + + { + my @ids = HasClassAttribute->IdsInMapping(); + is( + scalar @ids, 0, + 'there are no keys in the mapping yet' + ); + + ok( + !HasClassAttribute->ExistsInMapping('a'), + 'key does not exist in mapping' + ); + + HasClassAttribute->SetMapping( a => 20 ); + + ok( + HasClassAttribute->ExistsInMapping('a'), + 'key does exist in mapping' + ); + + is( + HasClassAttribute->GetMapping('a'), 20, + 'value for a in mapping is 20' + ); } -} + { + is( + HasClassAttribute->Built(), 42, + 'attribute with builder works' + ); + + is( + HasClassAttribute->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' ); + + HasClassAttribute->Triggerish(84); + is( HasClassAttribute->Triggerish(), 84, 'Triggerish is now 84' ); + + is_deeply( + \@HasClassAttribute::Triggered, + [ + [qw( HasClassAttribute 42 )], + [qw( HasClassAttribute 84 42 )], + ], + 'trigger passes old value correctly' + ); + } + + done_testing(); +} 1;