use Scalar::Util qw( isweak );
use Test::More;
-my $HasMXAH;
-BEGIN
-{
- if ( eval 'use MooseX::AttributeHelpers 0.09; 1;' )
- {
- $HasMXAH = 1;
- }
-}
-
-plan tests => 25;
-
+use vars qw($Lazy);
+$Lazy = 0;
+
+our %Attrs = (
+ ObjectCount => {
+ is => 'rw',
+ isa => 'Int',
+ default => 0,
+ },
+ WeakAttribute => {
+ is => 'rw',
+ isa => 'Object',
+ weak_ref => 1,
+ },
+ LazyAttribute => {
+ is => 'rw',
+ isa => 'Int',
+ lazy => 1,
+ # The side effect is used to test that this was called
+ # lazily.
+ default => sub { $Lazy = 1 },
+ },
+ ReadOnlyAttribute => {
+ is => 'ro',
+ isa => 'Int',
+ default => 10,
+ },
+ ManyNames => {
+ is => 'rw',
+ isa => 'Int',
+ reader => 'M',
+ writer => 'SetM',
+ clearer => 'ClearM',
+ predicate => 'HasM',
+ },
+ 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() },
+ },
+ Mapping => {
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef[Str]',
+ default => sub { {} },
+ handles => {
+ 'ExistsInMapping' => 'exists',
+ 'IdsInMapping' => 'keys',
+ 'GetMapping' => 'get',
+ 'SetMapping' => 'set',
+ },
+ },
+ Built => {
+ is => 'ro',
+ builder => '_BuildIt',
+ },
+ LazyBuilt => {
+ is => 'ro',
+ lazy => 1,
+ builder => '_BuildIt',
+ },
+ Triggerish => {
+ is => 'rw',
+ trigger => sub { shift->_CallTrigger(@_) },
+ },
+);
{
package HasClassAttribute;
use Moose qw( has );
use MooseX::ClassAttribute;
- use vars qw($Lazy);
- $Lazy = 0;
-
- class_has 'ObjectCount' =>
- ( is => 'rw',
- isa => 'Int',
- default => 0,
- );
-
- class_has 'WeakAttribute' =>
- ( is => 'rw',
- isa => 'Object',
- weak_ref => 1,
- );
-
- 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' ],
- default => sub { Delegatee->new() },
- );
-
- if ($HasMXAH)
- {
- class_has 'Mapping' =>
- ( metaclass => 'Collection::Hash',
- is => 'rw',
- isa => 'HashRef[Str]',
- default => sub { {} },
- provides =>
- { exists => 'ExistsInMapping',
- keys => 'IdsInMapping',
- get => 'GetMapping',
- set => 'SetMapping',
- },
- );
+ while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
+ class_has $name => %{$def};
}
- has 'size' =>
- ( is => 'rw',
- isa => 'Int',
- default => 5,
- );
+ has 'size' => (
+ is => 'rw',
+ isa => 'Int',
+ default => 5,
+ );
no Moose;
- no MooseX::ClassAttribute;
- sub BUILD
- {
+ sub BUILD {
my $self = shift;
$self->ObjectCount( $self->ObjectCount() + 1 );
}
- sub make_immutable
- {
+ sub _BuildIt {42}
+
+ our @Triggered;
+
+ sub _CallTrigger {
+ push @Triggered, [@_];
+ }
+
+ sub make_immutable {
my $class = shift;
$class->meta()->make_immutable();
- MooseX::ClassAttribute::container_class()->meta()->make_immutable();
Delegatee->meta()->make_immutable();
}
}
use Moose;
- has 'units' =>
- ( is => 'ro',
- default => 5,
- );
+ has 'units' => (
+ is => 'ro',
+ default => 5,
+ );
- has 'color' =>
- ( is => 'ro',
- default => 'blue',
- );
+ has 'color' => (
+ is => 'ro',
+ default => 'blue',
+ );
+
+ no Moose;
}
{
extends 'HasClassAttribute';
- class_has '+ReadOnlyAttribute' =>
- ( default => 30 );
+ class_has '+ReadOnlyAttribute' => ( default => 30 );
+
+ class_has 'YetAnotherAttribute' => (
+ is => 'ro',
+ default => 'thing',
+ );
+
+ no Moose;
}
-sub run_tests
-{
+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'
+ );
}
{
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' );
+ 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'
+ );
}
{
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(
+ $SharedTests::Lazy, 0,
+ '$SharedTests::Lazy is 0'
+ );
- is( HasClassAttribute->LazyAttribute(), 1,
- 'HasClassAttribute->LazyAttribute() is 1' );
+ is(
+ HasClassAttribute->LazyAttribute(), 1,
+ 'HasClassAttribute->LazyAttribute() is 1'
+ );
- is( $HasClassAttribute::Lazy, 1,
- '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' );
+ is(
+ $SharedTests::Lazy, 1,
+ '$SharedTests::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' );
+ 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} );
+ is(
+ Child->ReadOnlyAttribute(), 30,
+ q{Child class can extend parent's class attribute}
+ );
}
{
- ok( ! HasClassAttribute->HasM(),
- 'HasM() returns false before M is set' );
+ 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' );
+ 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' );
+ ok(
+ !HasClassAttribute->HasM(),
+ 'HasM() returns false after M is cleared'
+ );
}
{
- ok( ! HasClassAttribute->can('class_has'),
- q{'no MooseX::ClassAttribute' remove class_has from HasClassAttribute} );
+ isa_ok(
+ HasClassAttribute->Delegatee(), 'Delegatee',
+ 'has a Delegetee object'
+ );
+ is(
+ HasClassAttribute->units(), 5,
+ 'units() delegates to Delegatee and returns 5'
+ );
}
- SKIP:
{
- skip 'These tests require MooseX::AttributeHelpers', 4
- unless $HasMXAH;
-
my @ids = HasClassAttribute->IdsInMapping();
- is( scalar @ids, 0,
- 'there are no keys in the mapping yet' );
+ is(
+ scalar @ids, 0,
+ 'there are no keys in the mapping yet'
+ );
- ok( ! HasClassAttribute->ExistsInMapping('a'),
- 'key does not exist in mapping' );
+ ok(
+ !HasClassAttribute->ExistsInMapping('a'),
+ 'key does not exist in mapping'
+ );
HasClassAttribute->SetMapping( a => 20 );
- ok( HasClassAttribute->ExistsInMapping('a'),
- 'key does exist in mapping' );
+ ok(
+ HasClassAttribute->ExistsInMapping('a'),
+ 'key does exist in mapping'
+ );
- is( HasClassAttribute->GetMapping('a'), 20,
- 'value for a in mapping is 20' );
+ 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;
projects / gitmo/MooseX-ClassAttribute.git / blobdiff