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    package D;
  57
  58    use Moose;
  59    extends 'ConsumesDelegateToBar';
  60
  61    sub _bar { 'extended' }
  62
  63    has '+_barrer' => (
  64       is => 'rw',
  65       handles => { _baz => 'bar' },
  66    );
  67    package C;
  68
  69    use Moose;
  70    extends 'ConsumesDelegateToBar';
  71    with 'Does::OverrideDelegate';
  72
  73    has '+_barrer' => (
  74       is => 'rw',
  75       handles => { _baz => 'bar' },
  76    );
  77 }
  78
  79 is(A->new->_bar, 'extended', 'overriding delegate method with role works');
  80 is(D->new->_bar, 'extended', '... even when you specify other delegates in subclass');
  81 is(D->new->_baz, 'unextended!', '... and said other delegate still works');
  82 is(B->new->_bar, 'extended', 'overriding delegate method directly works');
  83 is(C->new->_bar, 'extended', '... even when you specify other delegates in subclass');
  84 is(C->new->_baz, 'unextended!', '... and said other delegate still works');
  85
  86 done_testing;
  87