t/attributes/delegation_and_modifiers.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 {
   9     package Bar;
  10     use Moose;
  11
  12     sub baz   { 'Bar::baz' }
  13     sub gorch { 'Bar::gorch' }
  14
  15     package Foo;
  16     use Moose;
  17
  18     has 'bar' => (
  19         is      => 'ro',
  20         isa     => 'Bar',
  21         lazy    => 1,
  22         default => sub { Bar->new },
  23         handles => [qw[ baz gorch ]]
  24     );
  25
  26     package Foo::Extended;
  27     use Moose;
  28
  29     extends 'Foo';
  30
  31     has 'test' => (
  32         is      => 'rw',
  33         isa     => 'Bool',
  34         default => sub { 0 },
  35     );
  36
  37     around 'bar' => sub {
  38         my $next = shift;
  39         my $self = shift;
  40
  41         $self->test(1);
  42         $self->$next();
  43     };
  44 }
  45
  46 my $foo = Foo::Extended->new;
  47 isa_ok($foo, 'Foo::Extended');
  48 isa_ok($foo, 'Foo');
  49
  50 ok(!$foo->test, '... the test value has not been changed');
  51
  52 is($foo->baz, 'Bar::baz', '... got the right delegated method');
  53
  54 ok($foo->test, '... the test value has now been changed');
  55
  56 done_testing;