Commit | Line | Data |
53b3e214 |
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 Moose; |
12 | |
13 | sub baz { 'Bar::baz' } |
14 | sub gorch { 'Bar::gorch' } |
15 | |
16 | package Foo; |
17 | use Moose; |
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 Moose; |
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 | |