pod for everything

[gitmo/MooseX-ClassAttribute.git] / t / lib / SharedTests.pm

diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm
index 3d9c242..d9e6cca 100644 (file)
--- a/t/lib/SharedTests.pm
+++ b/t/lib/SharedTests.pm
@@ -4,45 +4,155 @@ use strict;
 use warnings;
 
 use Scalar::Util qw( isweak );
-use Test::More tests => 9;
+use Test::More;
 
+my $HasMXAH;
+BEGIN
+{
+    if ( eval 'use MooseX::AttributeHelpers 0.13; 1;' )
+    {
+        $HasMXAH = 1;
+    }
+}
+
+sub HasMXAH { $HasMXAH }
 
 {
     package HasClassAttribute;
 
-    use Moose;
+    use Moose qw( has );
     use MooseX::ClassAttribute;
 
-    has 'ObjectCount' =>
-        ( metaclass => 'ClassAttribute',
-          is        => 'rw',
+    use vars qw($Lazy);
+    $Lazy = 0;
+
+    class_has 'ObjectCount' =>
+        ( is        => 'rw',
           isa       => 'Int',
           default   => 0,
         );
 
-    has 'WeakAttribute' =>
-        ( metaclass => 'ClassAttribute',
-          is        => 'rw',
+    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' ],
+          # if it's not lazy it makes a new object before we define
+          # Delegatee's attributes.
+          lazy    => 1,
+          default => sub { Delegatee->new() },
+        );
+
+    if ( SharedTests->HasMXAH() )
+    {
+        class_has 'Mapping' =>
+            ( metaclass => 'Collection::Hash',
+              is        => 'rw',
+              isa       => 'HashRef[Str]',
+              default   => sub { {} },
+              provides  =>
+              { exists => 'ExistsInMapping',
+                keys   => 'IdsInMapping',
+                get    => 'GetMapping',
+                set    => 'SetMapping',
+              },
+            );
+    }
+
     has 'size' =>
         ( is      => 'rw',
           isa     => 'Int',
           default => 5,
         );
 
+    no Moose;
+
     sub BUILD
     {
+        my $self = shift;
+
+        $self->ObjectCount( $self->ObjectCount() + 1 );
+    }
+
+    sub make_immutable
+    {
         my $class = shift;
 
-        $class->ObjectCount( $class->ObjectCount() + 1 );
+        $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;
+}
+
+{
+    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
 {
+    plan tests => 24;
+
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     {
@@ -67,7 +177,7 @@ sub run_tests
     {
         my $hca3 = HasClassAttribute->new( ObjectCount => 20 );
         is( $hca3->ObjectCount(), 3,
-            'class attributes are not affected by constructor params' );
+            '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' );
     }
@@ -77,9 +187,78 @@ sub run_tests
 
         HasClassAttribute->WeakAttribute($object);
 
-        ok( isweak( $HasClassAttribute::__ClassAttribute{WeakAttribute} ),
+        undef $object;
+
+        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' );
+    }
+
+ SKIP:
+    {
+        skip 'These tests require MooseX::AttributeHelpers', 4
+            unless SharedTests->HasMXAH();
+
+        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' );
+    }
 }