X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FSharedTests.pm;h=c0da1c5b7de4be5eeac33eb00316630e2b063e1f;hb=963254e04217abd070331648fec46af0e15e44c1;hp=9df7a6e14aa30771bf8c81ec0e3c3889b4ba2282;hpb=5091e7b52c1532d96210b3fe0779c831b5e4eb30;p=gitmo%2FMooseX-ClassAttribute.git

diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm
index 9df7a6e..c0da1c5 100644
--- a/t/lib/SharedTests.pm
+++ b/t/lib/SharedTests.pm
@@ -6,17 +6,76 @@ use warnings;
 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;
@@ -24,90 +83,36 @@ plan tests => 25;
     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();
     }
 }
@@ -117,15 +122,17 @@ plan tests => 25;
 
     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;
 }
 
 {
@@ -136,39 +143,60 @@ plan tests => 25;
 
     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'
+        );
     }
 
     {
@@ -178,82 +206,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(
+            $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;