X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F020_attributes%2F010_attribute_delegation.t;h=bcd4cc7bb7e6362b68960a766a5058dd83e82dc7;hb=4d438a84f437bcb3c43a04c27823b8b431cd3f55;hp=a792dc927684c05f8809e3cdc7e423e7a3d98a65;hpb=e1d6f0a3c8cee0350b97695a2307af7004a1eb97;p=gitmo%2FMoose.git

diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index a792dc9..bcd4cc7 100644
--- a/t/020_attributes/010_attribute_delegation.t
+++ b/t/020_attributes/010_attribute_delegation.t
@@ -3,31 +3,36 @@
 use strict;
 use warnings;
 
-use Test::More tests => 88;
+use Test::More;
 use Test::Exception;
 
 
-
 # -------------------------------------------------------------------
 # HASH handles
 # -------------------------------------------------------------------
 # the canonical form of of the 'handles'
-# option is the hash ref mapping a 
+# option is the hash ref mapping a
 # method name to the delegated method name
 
 {
     package Foo;
     use Moose;
 
-    has 'bar' => (is => 'rw', default => 10);    
+    has 'bar' => (is => 'rw', default => 10);
+
+    sub baz { 42 }
 
     package Bar;
-    use Moose; 
-    
+    use Moose;
+
     has 'foo' => (
         is      => 'rw',
         default => sub { Foo->new },
-        handles => { 'foo_bar' => 'bar' }
+        handles => {
+            'foo_bar' => 'bar',
+            foo_baz => 'baz',
+            'foo_bar_to_20' => [ bar => 20 ],
+        },
     );
 }
 
@@ -60,7 +65,7 @@ is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
 
 $bar->foo_bar(50);
 
-# and make sure everyone sees it 
+# and make sure everyone sees it
 
 is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
 is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
@@ -81,11 +86,15 @@ is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
 
+# curried handles
+$bar->foo_bar_to_20;
+is($bar->foo_bar, 20, '... correctly curried a single argument');
+
 # -------------------------------------------------------------------
-# ARRAY handles 
+# ARRAY handles
 # -------------------------------------------------------------------
 # we also support an array based format
-# which assumes that the name is the same 
+# which assumes that the name is the same
 # on either end
 
 {
@@ -93,11 +102,11 @@ is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
     use Moose;
 
     sub go   { 'Engine::go'   }
-    sub stop { 'Engine::stop' }    
+    sub stop { 'Engine::stop' }
 
     package Car;
-    use Moose; 
-    
+    use Moose;
+
     has 'engine' => (
         is      => 'rw',
         default => sub { Engine->new },
@@ -122,7 +131,7 @@ is($car->go, 'Engine::go', '... got the right value from ->go');
 is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
 # -------------------------------------------------------------------
-# REGEXP handles 
+# REGEXP handles
 # -------------------------------------------------------------------
 # and we support regexp delegation
 
@@ -131,38 +140,38 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     use Moose;
 
     sub foo { 'Baz::foo' }
-    sub bar { 'Baz::bar' }       
-    sub boo { 'Baz::boo' }            
+    sub bar { 'Baz::bar' }
+    sub boo { 'Baz::boo' }
 
     package Baz::Proxy1;
-    use Moose; 
-    
+    use Moose;
+
     has 'baz' => (
         is      => 'ro',
         isa     => 'Baz',
         default => sub { Baz->new },
         handles => qr/.*/
     );
-    
+
     package Baz::Proxy2;
-    use Moose; 
-    
+    use Moose;
+
     has 'baz' => (
         is      => 'ro',
         isa     => 'Baz',
         default => sub { Baz->new },
         handles => qr/.oo/
-    );    
-    
+    );
+
     package Baz::Proxy3;
-    use Moose; 
-    
+    use Moose;
+
     has 'baz' => (
         is      => 'ro',
         isa     => 'Baz',
         default => sub { Baz->new },
         handles => qr/b.*/
-    );    
+    );
 }
 
 {
@@ -175,10 +184,10 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     can_ok($baz_proxy, 'foo');
     can_ok($baz_proxy, 'bar');
     can_ok($baz_proxy, 'boo');
-    
+
     is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
     is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
-    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');    
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 }
 {
     my $baz_proxy = Baz::Proxy2->new;
@@ -189,9 +198,9 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     can_ok($baz_proxy, 'foo');
     can_ok($baz_proxy, 'boo');
-    
+
     is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
-    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');    
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 }
 {
     my $baz_proxy = Baz::Proxy3->new;
@@ -202,9 +211,9 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     can_ok($baz_proxy, 'bar');
     can_ok($baz_proxy, 'boo');
-    
+
     is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
-    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');    
+    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 }
 
 # -------------------------------------------------------------------
@@ -214,42 +223,64 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 {
     package Foo::Bar;
     use Moose::Role;
-    
+
     requires 'foo';
     requires 'bar';
-    
+
     package Foo::Baz;
     use Moose;
-    
+
     sub foo { 'Foo::Baz::FOO' }
     sub bar { 'Foo::Baz::BAR' }
-    sub baz { 'Foo::Baz::BAZ' }    
-    
+    sub baz { 'Foo::Baz::BAZ' }
+
     package Foo::Thing;
     use Moose;
-    
+
     has 'thing' => (
-        is      => 'rw', 
+        is      => 'rw',
         isa     => 'Foo::Baz',
         handles => 'Foo::Bar',
     );
 
+    package Foo::OtherThing;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    has 'other_thing' => (
+        is      => 'rw',
+        isa     => 'Foo::Baz',
+        handles => Moose::Util::TypeConstraints::find_type_constraint('Foo::Bar'),
+    );
 }
 
 {
     my $foo = Foo::Thing->new(thing => Foo::Baz->new);
     isa_ok($foo, 'Foo::Thing');
     isa_ok($foo->thing, 'Foo::Baz');
-    
+
     ok($foo->meta->has_method('foo'), '... we have the method we expect');
     ok($foo->meta->has_method('bar'), '... we have the method we expect');
-    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');  
-    
-    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');      
+    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
+
+    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
     is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
-    is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');        
+    is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
 }
 
+{
+    my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new);
+    isa_ok($foo, 'Foo::OtherThing');
+    isa_ok($foo->other_thing, 'Foo::Baz');
+
+    ok($foo->meta->has_method('foo'), '... we have the method we expect');
+    ok($foo->meta->has_method('bar'), '... we have the method we expect');
+    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
+
+    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
+    is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
+    is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value');
+}
 # -------------------------------------------------------------------
 # AUTOLOAD & handles
 # -------------------------------------------------------------------
@@ -262,7 +293,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
         my $self = shift;
 
         my $name = our $AUTOLOAD;
-        $name =~ s/.*://;		# strip fully-qualified portion
+        $name =~ s/.*://; # strip fully-qualified portion
 
         if (@_) {
             return $self->{$name} = shift;
@@ -272,32 +303,32 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     }
 
     package Bar::Autoloaded;
-    use Moose; 
-    
+    use Moose;
+
     has 'foo' => (
         is      => 'rw',
         default => sub { Foo::Autoloaded->new },
         handles => { 'foo_bar' => 'bar' }
     );
-    
+
     package Baz::Autoloaded;
-    use Moose; 
-    
+    use Moose;
+
     has 'foo' => (
         is      => 'rw',
         default => sub { Foo::Autoloaded->new },
         handles => ['bar']
-    );    
-    
+    );
+
     package Goorch::Autoloaded;
-    use Moose; 
-    
+    use Moose;
+
     ::dies_ok {
         has 'foo' => (
             is      => 'rw',
             default => sub { Foo::Autoloaded->new },
             handles => qr/bar/
-        );    
+        );
     } '... you cannot delegate to AUTOLOADED class with regexp';
 }
 
@@ -323,7 +354,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     $bar->foo_bar(50);
 
-    # and make sure everyone sees it 
+    # and make sure everyone sees it
 
     is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
     is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
@@ -334,7 +365,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     isa_ok($foo, 'Foo::Autoloaded');
 
     $foo->bar(25);
-    
+
     is($foo->bar, 25, '... got the right foo->bar');
 
     lives_ok {
@@ -369,7 +400,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
     $baz->bar(50);
 
-    # and make sure everyone sees it 
+    # and make sure everyone sees it
 
     is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
     is($baz->bar, 50, '... baz->foo_bar delegated correctly');
@@ -380,7 +411,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     isa_ok($foo, 'Foo::Autoloaded');
 
     $foo->bar(25);
-    
+
     is($foo->bar, 25, '... got the right foo->bar');
 
     lives_ok {
@@ -398,8 +429,8 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     {
         package Quux;
         use Moose;
-        has foo => ( 
-            isa => 'Foo', 
+        has foo => (
+            isa => 'Foo',
             default => sub { Foo->new },
             handles => { 'foo_bar' => 'bar' }
         );
@@ -410,3 +441,19 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');
 }
 
+# Make sure that a useful error message is thrown when the delegation target is
+# not an object
+{
+    my $i = Bar->new(foo => undef);
+    throws_ok { $i->foo_bar } qr/is not defined/,
+        'useful error from unblessed reference';
+
+    my $j = Bar->new(foo => []);
+    throws_ok { $j->foo_bar } qr/is not an object \(got 'ARRAY/,
+        'useful error from unblessed reference';
+
+    my $k = Bar->new(foo => "Foo");
+    lives_ok { $k->foo_baz } "but not for class name";
+}
+
+done_testing;