Commit | Line | Data |
452bac1b |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 46; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | } |
12 | |
13 | # the canonical form of of the 'handles' |
14 | # option is the hash ref mapping a |
15 | # method name to the delegated method name |
16 | |
17 | { |
18 | package Foo; |
452bac1b |
19 | use Moose; |
20 | |
21 | has 'bar' => (is => 'rw', default => 10); |
22 | |
23 | package Bar; |
452bac1b |
24 | use Moose; |
25 | |
26 | has 'foo' => ( |
27 | is => 'rw', |
28 | default => sub { Foo->new }, |
29 | handles => { 'foo_bar' => 'bar' } |
30 | ); |
31 | } |
32 | |
33 | my $bar = Bar->new; |
34 | isa_ok($bar, 'Bar'); |
35 | |
36 | ok($bar->foo, '... we have something in bar->foo'); |
37 | isa_ok($bar->foo, 'Foo'); |
38 | |
39 | is($bar->foo->bar, 10, '... bar->foo->bar returned the right default'); |
40 | |
41 | can_ok($bar, 'foo_bar'); |
42 | is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly'); |
43 | |
44 | my $foo = Foo->new(bar => 25); |
45 | isa_ok($foo, 'Foo'); |
46 | |
47 | is($foo->bar, 25, '... got the right foo->bar'); |
48 | |
49 | lives_ok { |
50 | $bar->foo($foo); |
51 | } '... assigned the new Foo to Bar->foo'; |
52 | |
53 | is($bar->foo, $foo, '... assigned bar->foo with the new Foo'); |
54 | |
55 | is($bar->foo->bar, 25, '... bar->foo->bar returned the right result'); |
56 | is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again'); |
57 | |
58 | # we also support an array based format |
59 | # which assumes that the name is the same |
60 | # on either end |
61 | |
62 | { |
63 | package Engine; |
452bac1b |
64 | use Moose; |
65 | |
66 | sub go { 'Engine::go' } |
67 | sub stop { 'Engine::stop' } |
68 | |
69 | package Car; |
452bac1b |
70 | use Moose; |
71 | |
72 | has 'engine' => ( |
73 | is => 'rw', |
74 | default => sub { Engine->new }, |
75 | handles => [ 'go', 'stop' ] |
76 | ); |
77 | } |
78 | |
79 | my $car = Car->new; |
80 | isa_ok($car, 'Car'); |
81 | |
82 | isa_ok($car->engine, 'Engine'); |
83 | can_ok($car->engine, 'go'); |
84 | can_ok($car->engine, 'stop'); |
85 | |
86 | is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go'); |
87 | is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop'); |
88 | |
89 | can_ok($car, 'go'); |
90 | can_ok($car, 'stop'); |
91 | |
92 | is($car->go, 'Engine::go', '... got the right value from ->go'); |
93 | is($car->stop, 'Engine::stop', '... got the right value from ->stop'); |
94 | |
95 | # and we support regexp delegation |
96 | |
97 | { |
98 | package Baz; |
452bac1b |
99 | use Moose; |
100 | |
101 | sub foo { 'Baz::foo' } |
102 | sub bar { 'Baz::bar' } |
103 | sub boo { 'Baz::boo' } |
104 | |
105 | package Baz::Proxy1; |
452bac1b |
106 | use Moose; |
107 | |
108 | has 'baz' => ( |
109 | is => 'ro', |
110 | isa => 'Baz', |
111 | default => sub { Baz->new }, |
112 | handles => qr/.*/ |
113 | ); |
114 | |
115 | package Baz::Proxy2; |
452bac1b |
116 | use Moose; |
117 | |
118 | has 'baz' => ( |
119 | is => 'ro', |
120 | isa => 'Baz', |
121 | default => sub { Baz->new }, |
122 | handles => qr/.oo/ |
123 | ); |
124 | |
125 | package Baz::Proxy3; |
452bac1b |
126 | use Moose; |
127 | |
128 | has 'baz' => ( |
129 | is => 'ro', |
130 | isa => 'Baz', |
131 | default => sub { Baz->new }, |
132 | handles => qr/b.*/ |
133 | ); |
134 | } |
135 | |
136 | { |
137 | my $baz_proxy = Baz::Proxy1->new; |
138 | isa_ok($baz_proxy, 'Baz::Proxy1'); |
139 | |
140 | can_ok($baz_proxy, 'baz'); |
141 | isa_ok($baz_proxy->baz, 'Baz'); |
142 | |
143 | can_ok($baz_proxy, 'foo'); |
144 | can_ok($baz_proxy, 'bar'); |
145 | can_ok($baz_proxy, 'boo'); |
146 | |
147 | is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); |
148 | is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); |
149 | is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); |
150 | } |
151 | { |
152 | my $baz_proxy = Baz::Proxy2->new; |
153 | isa_ok($baz_proxy, 'Baz::Proxy2'); |
154 | |
155 | can_ok($baz_proxy, 'baz'); |
156 | isa_ok($baz_proxy->baz, 'Baz'); |
157 | |
158 | can_ok($baz_proxy, 'foo'); |
159 | can_ok($baz_proxy, 'boo'); |
160 | |
161 | is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); |
162 | is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); |
163 | } |
164 | { |
165 | my $baz_proxy = Baz::Proxy3->new; |
166 | isa_ok($baz_proxy, 'Baz::Proxy3'); |
167 | |
168 | can_ok($baz_proxy, 'baz'); |
169 | isa_ok($baz_proxy->baz, 'Baz'); |
170 | |
171 | can_ok($baz_proxy, 'bar'); |
172 | can_ok($baz_proxy, 'boo'); |
173 | |
174 | is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); |
175 | is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); |
176 | } |
177 | |
178 | |