X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Faccessor-handles.t;h=2125784420425d2b0636ec47cad7a3d4df224a66;hb=a6d0da2fc8dbf846b6dce694af7bdc4a8c440376;hp=aee5958ba2004e2b9fee59c20e0238fac18c8a84;hpb=3f343f5cd95883376dbe6cd19a4db577bcf0fbc7;p=gitmo%2FMoo.git

diff --git a/t/accessor-handles.t b/t/accessor-handles.t
index aee5958..2125784 100644
--- a/t/accessor-handles.t
+++ b/t/accessor-handles.t
@@ -1,5 +1,16 @@
 use strictures 1;
 use Test::More;
+use Test::Fatal;
+
+use lib "t/lib";
+
+{
+  package Baz;
+  use Moo;
+  sub beep {'beep'}
+
+  sub is_passed_undefined { !defined($_[0]) ? 'bar' : 'fail' }
+}
 
 {
   package Robot;
@@ -7,6 +18,7 @@ use Test::More;
   use Moo::Role;
 
   requires 'smash';
+  $INC{"Robot.pm"} = 1;
 
 }
 
@@ -34,10 +46,19 @@ use Test::More;
   has foo4 => ( is => 'ro', handles => {
      eat_curry => [ yum => 'Curry!' ],
   });
+  has foo5 => ( is => 'ro', handles => 'ExtRobot' );
+  has foo6 => ( is => 'rw',
+                handles => { foobot => '${\\Baz->can("beep")}'},
+                default => sub { 0 } );
+  has foo7 => ( is => 'rw',
+                handles => { foobar => '${\\Baz->can("is_passed_undefined")}'},
+                default => sub { undef } );
+
 }
 
 my $bar = Bar->new(
-  foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new
+  foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new,
+  foo5 => Baz->new
 );
 
 is $bar->one, 1, 'handles works';
@@ -47,6 +68,27 @@ is $bar->un, 1, 'handles works for aliasing a method';
 
 is $bar->smash, 'smash', 'handles works for a role';
 
+is $bar->beep, 'beep', 'handles loads roles';
+
 is $bar->eat_curry, 'Curry!', 'handles works for currying';
 
+is $bar->foobot, 'beep', 'asserter checks for existence not truth, on false value';
+
+is $bar->foobar, 'bar', 'asserter checks for existence not truth, on undef ';
+
+ok(my $e = exception {
+  package Baz;
+  use Moo;
+  has foo => ( is => 'ro', handles => 'Robot' );
+  sub smash { 1 };
+}, 'handles will not overwrite locally defined method');
+like $e, qr{You cannot overwrite a locally defined method \(smash\) with a delegation},
+  '... and has correct error message';
+
+ok(exception {
+  package Fuzz;
+  use Moo;
+  has foo => ( is => 'ro', handles => $bar );
+}, 'invalid handles throws exception');
+
 done_testing;