t/020_attributes/failing/031_delegation_and_modifiers.t

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