t/sub-and-handles.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 {
   5    package DelegateBar;
   6
   7    use Moo;
   8
   9    sub bar { 'unextended!' }
  10
  11    package Does::DelegateToBar;
  12
  13    use Moo::Role;
  14
  15    has _barrer => (
  16       is => 'ro',
  17       default => sub { DelegateBar->new },
  18       handles => { _bar => 'bar' },
  19    );
  20
  21    sub get_barrer { $_[0]->_barrer }
  22
  23    package ConsumesDelegateToBar;
  24
  25    use Moo;
  26
  27    with 'Does::DelegateToBar';
  28
  29    has bong => ( is => 'ro' );
  30
  31    package Does::OverrideDelegate;
  32
  33    use Moo::Role;
  34
  35    sub _bar { 'extended' }
  36
  37    package A;
  38
  39    use Moo;
  40    extends 'ConsumesDelegateToBar';
  41    with 'Does::OverrideDelegate';
  42
  43    has '+_barrer' => ( is => 'rw' );
  44
  45    package B;
  46
  47    use Moo;
  48    extends 'ConsumesDelegateToBar';
  49
  50    sub _bar { 'extended' }
  51
  52    has '+_barrer' => ( is => 'rw' );
  53 }
  54
  55 is(A->new->_bar, 'extended', 'overriding delegate method with role works');
  56 is(B->new->_bar, 'extended', 'overriding delegate method directly works');
  57
  58 done_testing;
  59