t/bugs/sub-and-handles.t

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