Commit | Line | Data |
db1ab48d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
d79e62fd |
6 | use Test::More tests => 90; |
db1ab48d |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | use_ok('Moose::Role'); |
12 | } |
13 | |
14 | =pod |
15 | |
16 | Mutually recursive roles. |
17 | |
18 | =cut |
19 | |
20 | { |
21 | package Role::Foo; |
22 | use strict; |
23 | use warnings; |
24 | use Moose::Role; |
25 | |
26 | requires 'foo'; |
27 | |
28 | sub bar { 'Role::Foo::bar' } |
29 | |
30 | package Role::Bar; |
31 | use strict; |
32 | use warnings; |
33 | use Moose::Role; |
34 | |
35 | requires 'bar'; |
36 | |
37 | sub foo { 'Role::Bar::foo' } |
38 | } |
39 | |
40 | { |
41 | package My::Test1; |
42 | use strict; |
43 | use warnings; |
44 | use Moose; |
45 | |
46 | ::lives_ok { |
47 | with 'Role::Foo', 'Role::Bar'; |
48 | } '... our mutually recursive roles combine okay'; |
49 | |
50 | package My::Test2; |
51 | use strict; |
52 | use warnings; |
53 | use Moose; |
54 | |
55 | ::lives_ok { |
56 | with 'Role::Bar', 'Role::Foo'; |
57 | } '... our mutually recursive roles combine okay (no matter what order)'; |
58 | } |
59 | |
60 | my $test1 = My::Test1->new; |
61 | isa_ok($test1, 'My::Test1'); |
62 | |
63 | ok($test1->does('Role::Foo'), '... $test1 does Role::Foo'); |
64 | ok($test1->does('Role::Bar'), '... $test1 does Role::Bar'); |
65 | |
66 | can_ok($test1, 'foo'); |
67 | can_ok($test1, 'bar'); |
68 | |
69 | is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked'); |
70 | is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked'); |
71 | |
72 | my $test2 = My::Test2->new; |
73 | isa_ok($test2, 'My::Test2'); |
74 | |
75 | ok($test2->does('Role::Foo'), '... $test2 does Role::Foo'); |
76 | ok($test2->does('Role::Bar'), '... $test2 does Role::Bar'); |
77 | |
78 | can_ok($test2, 'foo'); |
79 | can_ok($test2, 'bar'); |
80 | |
81 | is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked'); |
82 | is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked'); |
83 | |
84 | # check some meta-stuff |
85 | |
86 | ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method'); |
87 | ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method'); |
88 | |
89 | ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method'); |
90 | ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method'); |
91 | |
92 | =pod |
93 | |
94 | Role method conflicts |
95 | |
96 | =cut |
97 | |
98 | { |
99 | package Role::Bling; |
100 | use strict; |
101 | use warnings; |
102 | use Moose::Role; |
103 | |
104 | sub bling { 'Role::Bling::bling' } |
105 | |
106 | package Role::Bling::Bling; |
107 | use strict; |
108 | use warnings; |
109 | use Moose::Role; |
110 | |
111 | sub bling { 'Role::Bling::Bling::bling' } |
112 | } |
113 | |
114 | { |
115 | package My::Test3; |
116 | use strict; |
117 | use warnings; |
118 | use Moose; |
119 | |
120 | ::throws_ok { |
121 | with 'Role::Bling', 'Role::Bling::Bling'; |
122 | } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required'; |
123 | |
124 | package My::Test4; |
125 | use strict; |
126 | use warnings; |
127 | use Moose; |
128 | |
129 | ::lives_ok { |
130 | with 'Role::Bling'; |
131 | with 'Role::Bling::Bling'; |
132 | } '... role methods didnt conflict when manually combined'; |
133 | |
134 | package My::Test5; |
135 | use strict; |
136 | use warnings; |
137 | use Moose; |
138 | |
139 | ::lives_ok { |
140 | with 'Role::Bling::Bling'; |
141 | with 'Role::Bling'; |
142 | } '... role methods didnt conflict when manually combined (in opposite order)'; |
143 | |
144 | package My::Test6; |
145 | use strict; |
146 | use warnings; |
147 | use Moose; |
148 | |
149 | ::lives_ok { |
150 | with 'Role::Bling::Bling', 'Role::Bling'; |
151 | } '... role methods didnt conflict when manually resolved'; |
152 | |
153 | sub bling { 'My::Test6::bling' } |
154 | } |
155 | |
156 | ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict'); |
157 | ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
158 | ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
159 | ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
160 | |
d79e62fd |
161 | ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles'); |
162 | ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
163 | ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles'); |
164 | ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
165 | ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles'); |
166 | ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
167 | ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles'); |
168 | ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
169 | |
db1ab48d |
170 | is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added'); |
171 | is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added'); |
172 | is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method'); |
173 | |
174 | # check how this affects role compostion |
175 | |
176 | { |
177 | package Role::Bling::Bling::Bling; |
178 | use strict; |
179 | use warnings; |
180 | use Moose::Role; |
181 | |
182 | with 'Role::Bling::Bling'; |
183 | |
184 | sub bling { 'Role::Bling::Bling::Bling::bling' } |
185 | } |
186 | |
187 | ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling'); |
d79e62fd |
188 | ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role'); |
db1ab48d |
189 | ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling'); |
d05cd563 |
190 | is(Role::Bling::Bling::Bling->meta->get_method('bling')->(), |
191 | 'Role::Bling::Bling::Bling::bling', |
192 | '... still got the bling method in Role::Bling::Bling::Bling'); |
db1ab48d |
193 | |
194 | =pod |
195 | |
196 | Role attribute conflicts |
197 | |
198 | =cut |
199 | |
200 | { |
201 | package Role::Boo; |
202 | use strict; |
203 | use warnings; |
204 | use Moose::Role; |
205 | |
206 | has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost'); |
207 | |
208 | package Role::Boo::Hoo; |
209 | use strict; |
210 | use warnings; |
211 | use Moose::Role; |
212 | |
213 | has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost'); |
214 | } |
215 | |
216 | { |
217 | package My::Test7; |
218 | use strict; |
219 | use warnings; |
220 | use Moose; |
221 | |
222 | ::throws_ok { |
223 | with 'Role::Boo', 'Role::Boo::Hoo'; |
224 | } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/, |
225 | '... role attrs conflicted and method was required'; |
226 | |
227 | package My::Test8; |
228 | use strict; |
229 | use warnings; |
230 | use Moose; |
231 | |
232 | ::lives_ok { |
233 | with 'Role::Boo'; |
234 | with 'Role::Boo::Hoo'; |
235 | } '... role attrs didnt conflict when manually combined'; |
236 | |
237 | package My::Test9; |
238 | use strict; |
239 | use warnings; |
240 | use Moose; |
241 | |
242 | ::lives_ok { |
243 | with 'Role::Boo::Hoo'; |
244 | with 'Role::Boo'; |
245 | } '... role attrs didnt conflict when manually combined'; |
246 | |
247 | package My::Test10; |
248 | use strict; |
249 | use warnings; |
250 | use Moose; |
251 | |
252 | has 'ghost' => (is => 'ro', default => 'My::Test10::ghost'); |
253 | |
254 | ::throws_ok { |
255 | with 'Role::Boo', 'Role::Boo::Hoo'; |
256 | } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/, |
257 | '... role attrs conflicted and cannot be manually disambiguted'; |
258 | |
259 | } |
260 | |
261 | ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict'); |
262 | ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
263 | ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
264 | ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)'); |
265 | |
d79e62fd |
266 | ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles'); |
267 | ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
268 | ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles'); |
269 | ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
270 | ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles'); |
271 | ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
272 | ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles'); |
273 | ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
274 | |
db1ab48d |
275 | can_ok('My::Test8', 'ghost'); |
276 | can_ok('My::Test9', 'ghost'); |
277 | can_ok('My::Test10', 'ghost'); |
278 | |
279 | is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value'); |
280 | is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value'); |
281 | is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value'); |
282 | |
d05cd563 |
283 | =pod |
284 | |
285 | Role override method conflicts |
286 | |
287 | =cut |
288 | |
289 | { |
d79e62fd |
290 | package Role::Plot; |
d05cd563 |
291 | use strict; |
292 | use warnings; |
293 | use Moose::Role; |
294 | |
295 | override 'twist' => sub { |
d79e62fd |
296 | super() . ' -> Role::Plot::twist'; |
d05cd563 |
297 | }; |
298 | |
d79e62fd |
299 | package Role::Truth; |
d05cd563 |
300 | use strict; |
301 | use warnings; |
302 | use Moose::Role; |
303 | |
304 | override 'twist' => sub { |
d79e62fd |
305 | super() . ' -> Role::Truth::twist'; |
d05cd563 |
306 | }; |
307 | } |
308 | |
309 | { |
310 | package My::Test::Base; |
311 | use strict; |
312 | use warnings; |
313 | use Moose; |
314 | |
315 | sub twist { 'My::Test::Base::twist' } |
316 | |
317 | package My::Test11; |
318 | use strict; |
319 | use warnings; |
320 | use Moose; |
321 | |
322 | extends 'My::Test::Base'; |
323 | |
324 | ::lives_ok { |
d79e62fd |
325 | with 'Role::Truth'; |
d05cd563 |
326 | } '... composed the role with override okay'; |
327 | |
328 | package My::Test12; |
329 | use strict; |
330 | use warnings; |
331 | use Moose; |
332 | |
333 | extends 'My::Test::Base'; |
334 | |
335 | ::lives_ok { |
d79e62fd |
336 | with 'Role::Plot'; |
d05cd563 |
337 | } '... composed the role with override okay'; |
338 | |
339 | package My::Test13; |
340 | use strict; |
341 | use warnings; |
342 | use Moose; |
343 | |
344 | ::dies_ok { |
d79e62fd |
345 | with 'Role::Plot'; |
d05cd563 |
346 | } '... cannot compose it because we have no superclass'; |
347 | |
348 | package My::Test14; |
349 | use strict; |
350 | use warnings; |
351 | use Moose; |
352 | |
353 | extends 'My::Test::Base'; |
354 | |
355 | ::throws_ok { |
d79e62fd |
356 | with 'Role::Plot', 'Role::Truth'; |
d05cd563 |
357 | } qr/Two \'override\' methods of the same name encountered/, |
061a963b |
358 | '... cannot compose it because we have no superclass'; |
d05cd563 |
359 | } |
360 | |
361 | ok(My::Test11->meta->has_method('twist'), '... the twist method has been added'); |
362 | ok(My::Test12->meta->has_method('twist'), '... the twist method has been added'); |
363 | ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added'); |
364 | ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added'); |
365 | |
d79e62fd |
366 | ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles'); |
367 | ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles'); |
368 | ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles'); |
369 | ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles'); |
370 | ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles'); |
371 | ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles'); |
372 | ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles'); |
373 | |
374 | is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return'); |
375 | is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return'); |
061a963b |
376 | ok(!My::Test13->can('twist'), '... no twist method here at all'); |
377 | is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)'); |
db1ab48d |
378 | |
d79e62fd |
379 | { |
380 | package Role::Reality; |
381 | use strict; |
382 | use warnings; |
383 | use Moose::Role; |
384 | |
385 | ::throws_ok { |
386 | with 'Role::Plot'; |
387 | } qr/A local method of the same name as been found/, |
388 | '... could not compose roles here, it dies'; |
389 | |
390 | sub twist { |
391 | 'Role::Reality::twist'; |
392 | } |
393 | } |
394 | |
395 | ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added'); |
396 | ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles'); |
397 | is(Role::Reality->meta->get_method('twist')->(), |
398 | 'Role::Reality::twist', |
399 | '... the twist method returns the right value'); |