t/accessor-handles.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 use lib "t/lib";
   6
   7 {
   8   package Baz;
   9   use Moo;
  10   sub beep {'beep'}
  11
  12   sub is_passed_undefined { !defined($_[0]) ? 'bar' : 'fail' }
  13 }
  14
  15 {
  16   package Robot;
  17
  18   use Moo::Role;
  19
  20   requires 'smash';
  21   $INC{"Robot.pm"} = 1;
  22
  23 }
  24
  25 {
  26   package Foo;
  27
  28   use Moo;
  29
  30   with 'Robot';
  31
  32   sub one {1}
  33   sub two {2}
  34   sub smash {'smash'}
  35   sub yum {$_[1]}
  36 }
  37
  38 {
  39   package Bar;
  40
  41   use Moo;
  42
  43   has foo => ( is => 'ro', handles => [ qw(one two) ] );
  44   has foo2 => ( is => 'ro', handles => { un => 'one' } );
  45   has foo3 => ( is => 'ro', handles => 'Robot' );
  46   has foo4 => ( is => 'ro', handles => {
  47      eat_curry => [ yum => 'Curry!' ],
  48   });
  49   has foo5 => ( is => 'ro', handles => 'ExtRobot' );
  50   has foo6 => ( is => 'rw',
  51                 handles => { foobot => '${\\Baz->can("beep")}'},
  52                 default => sub { 0 } );
  53   has foo7 => ( is => 'rw',
  54                 handles => { foobar => '${\\Baz->can("is_passed_undefined")}'},
  55                 default => sub { undef } );
  56
  57 }
  58
  59 my $bar = Bar->new(
  60   foo => Foo->new, foo2 => Foo->new, foo3 => Foo->new, foo4 => Foo->new,
  61   foo5 => Baz->new
  62 );
  63
  64 is $bar->one, 1, 'handles works';
  65 is $bar->two, 2, 'handles works for more than one method';
  66
  67 is $bar->un, 1, 'handles works for aliasing a method';
  68
  69 is $bar->smash, 'smash', 'handles works for a role';
  70
  71 is $bar->beep, 'beep', 'handles loads roles';
  72
  73 is $bar->eat_curry, 'Curry!', 'handles works for currying';
  74
  75 is $bar->foobot, 'beep', 'asserter checks for existence not truth, on false value';
  76
  77 is $bar->foobar, 'bar', 'asserter checks for existence not truth, on undef ';
  78
  79 ok(my $e = exception {
  80   package Baz;
  81   use Moo;
  82   has foo => ( is => 'ro', handles => 'Robot' );
  83   sub smash { 1 };
  84 }, 'handles will not overwrite locally defined method');
  85 like $e, qr{You cannot overwrite a locally defined method \(smash\) with a delegation},
  86   '... and has correct error message';
  87
  88 ok(exception {
  89   package Fuzz;
  90   use Moo;
  91   has foo => ( is => 'ro', handles => $bar );
  92 }, 'invalid handles throws exception');
  93
  94 done_testing;