t/accessor-handles.t

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