Commit | Line | Data |
db1ab48d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
d443cad0 |
6 | use Test::More tests => 89; |
db1ab48d |
7 | use Test::Exception; |
d443cad0 |
8 | use Test::Output; |
db1ab48d |
9 | |
db1ab48d |
10 | =pod |
11 | |
12 | Mutually recursive roles. |
13 | |
14 | =cut |
15 | |
16 | { |
17 | package Role::Foo; |
db1ab48d |
18 | use Moose::Role; |
19 | |
20 | requires 'foo'; |
21 | |
22 | sub bar { 'Role::Foo::bar' } |
23 | |
24 | package Role::Bar; |
db1ab48d |
25 | use Moose::Role; |
26 | |
27 | requires 'bar'; |
28 | |
29 | sub foo { 'Role::Bar::foo' } |
30 | } |
31 | |
32 | { |
33 | package My::Test1; |
db1ab48d |
34 | use Moose; |
35 | |
36 | ::lives_ok { |
37 | with 'Role::Foo', 'Role::Bar'; |
38 | } '... our mutually recursive roles combine okay'; |
39 | |
40 | package My::Test2; |
db1ab48d |
41 | use Moose; |
42 | |
43 | ::lives_ok { |
44 | with 'Role::Bar', 'Role::Foo'; |
45 | } '... our mutually recursive roles combine okay (no matter what order)'; |
46 | } |
47 | |
48 | my $test1 = My::Test1->new; |
49 | isa_ok($test1, 'My::Test1'); |
50 | |
51 | ok($test1->does('Role::Foo'), '... $test1 does Role::Foo'); |
52 | ok($test1->does('Role::Bar'), '... $test1 does Role::Bar'); |
53 | |
54 | can_ok($test1, 'foo'); |
55 | can_ok($test1, 'bar'); |
56 | |
57 | is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked'); |
58 | is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked'); |
59 | |
60 | my $test2 = My::Test2->new; |
61 | isa_ok($test2, 'My::Test2'); |
62 | |
63 | ok($test2->does('Role::Foo'), '... $test2 does Role::Foo'); |
64 | ok($test2->does('Role::Bar'), '... $test2 does Role::Bar'); |
65 | |
66 | can_ok($test2, 'foo'); |
67 | can_ok($test2, 'bar'); |
68 | |
69 | is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked'); |
70 | is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked'); |
71 | |
72 | # check some meta-stuff |
73 | |
74 | ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method'); |
75 | ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method'); |
76 | |
77 | ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method'); |
78 | ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method'); |
79 | |
80 | =pod |
81 | |
82 | Role method conflicts |
83 | |
84 | =cut |
85 | |
86 | { |
87 | package Role::Bling; |
db1ab48d |
88 | use Moose::Role; |
89 | |
90 | sub bling { 'Role::Bling::bling' } |
91 | |
92 | package Role::Bling::Bling; |
db1ab48d |
93 | use Moose::Role; |
94 | |
95 | sub bling { 'Role::Bling::Bling::bling' } |
96 | } |
97 | |
98 | { |
99 | package My::Test3; |
db1ab48d |
100 | use Moose; |
101 | |
102 | ::throws_ok { |
103 | with 'Role::Bling', 'Role::Bling::Bling'; |
104 | } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required'; |
105 | |
106 | package My::Test4; |
db1ab48d |
107 | use Moose; |
108 | |
109 | ::lives_ok { |
110 | with 'Role::Bling'; |
d443cad0 |
111 | |
112 | ::stderr_like { |
113 | with 'Role::Bling::Bling'; |
114 | } qr/The My::Test4 class has implicitly overridden the method \(bling\) from role Role::Bling::Bling\./; |
115 | |
db1ab48d |
116 | } '... role methods didnt conflict when manually combined'; |
117 | |
118 | package My::Test5; |
db1ab48d |
119 | use Moose; |
120 | |
121 | ::lives_ok { |
122 | with 'Role::Bling::Bling'; |
d443cad0 |
123 | |
124 | ::stderr_like { |
125 | with 'Role::Bling'; |
126 | } qr/The My::Test5 class has implicitly overridden the method \(bling\) from role Role::Bling\./; |
db1ab48d |
127 | } '... role methods didnt conflict when manually combined (in opposite order)'; |
128 | |
129 | package My::Test6; |
db1ab48d |
130 | use Moose; |
131 | |
132 | ::lives_ok { |
133 | with 'Role::Bling::Bling', 'Role::Bling'; |
134 | } '... role methods didnt conflict when manually resolved'; |
135 | |
136 | sub bling { 'My::Test6::bling' } |
137 | } |
138 | |
139 | ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict'); |
140 | ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
141 | ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
142 | ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
143 | |
d79e62fd |
144 | ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles'); |
145 | ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
146 | ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles'); |
147 | ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
148 | ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles'); |
149 | ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
150 | ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles'); |
151 | ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
152 | |
db1ab48d |
153 | is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added'); |
154 | is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added'); |
155 | is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method'); |
156 | |
157 | # check how this affects role compostion |
158 | |
159 | { |
160 | package Role::Bling::Bling::Bling; |
db1ab48d |
161 | use Moose::Role; |
162 | |
163 | with 'Role::Bling::Bling'; |
164 | |
165 | sub bling { 'Role::Bling::Bling::Bling::bling' } |
166 | } |
167 | |
168 | ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling'); |
d79e62fd |
169 | ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role'); |
fb1e11d5 |
170 | ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have the bling method in Role::Bling::Bling::Bling'); |
d05cd563 |
171 | is(Role::Bling::Bling::Bling->meta->get_method('bling')->(), |
172 | 'Role::Bling::Bling::Bling::bling', |
173 | '... still got the bling method in Role::Bling::Bling::Bling'); |
db1ab48d |
174 | |
fb1e11d5 |
175 | |
db1ab48d |
176 | =pod |
177 | |
178 | Role attribute conflicts |
179 | |
180 | =cut |
181 | |
182 | { |
183 | package Role::Boo; |
db1ab48d |
184 | use Moose::Role; |
185 | |
186 | has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost'); |
187 | |
188 | package Role::Boo::Hoo; |
db1ab48d |
189 | use Moose::Role; |
190 | |
191 | has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost'); |
192 | } |
193 | |
194 | { |
195 | package My::Test7; |
db1ab48d |
196 | use Moose; |
197 | |
198 | ::throws_ok { |
199 | with 'Role::Boo', 'Role::Boo::Hoo'; |
fb1e11d5 |
200 | } qr/We have encountered an attribute conflict/, |
db1ab48d |
201 | '... role attrs conflicted and method was required'; |
202 | |
203 | package My::Test8; |
db1ab48d |
204 | use Moose; |
205 | |
206 | ::lives_ok { |
207 | with 'Role::Boo'; |
208 | with 'Role::Boo::Hoo'; |
209 | } '... role attrs didnt conflict when manually combined'; |
210 | |
211 | package My::Test9; |
db1ab48d |
212 | use Moose; |
213 | |
214 | ::lives_ok { |
215 | with 'Role::Boo::Hoo'; |
216 | with 'Role::Boo'; |
217 | } '... role attrs didnt conflict when manually combined'; |
218 | |
219 | package My::Test10; |
db1ab48d |
220 | use Moose; |
221 | |
222 | has 'ghost' => (is => 'ro', default => 'My::Test10::ghost'); |
223 | |
224 | ::throws_ok { |
225 | with 'Role::Boo', 'Role::Boo::Hoo'; |
fb1e11d5 |
226 | } qr/We have encountered an attribute conflict/, |
db1ab48d |
227 | '... role attrs conflicted and cannot be manually disambiguted'; |
228 | |
229 | } |
230 | |
231 | ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict'); |
232 | ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
233 | ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
234 | ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)'); |
235 | |
d79e62fd |
236 | ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles'); |
237 | ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
238 | ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles'); |
239 | ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
240 | ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles'); |
241 | ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
242 | ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles'); |
243 | ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
244 | |
db1ab48d |
245 | can_ok('My::Test8', 'ghost'); |
246 | can_ok('My::Test9', 'ghost'); |
247 | can_ok('My::Test10', 'ghost'); |
248 | |
249 | is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value'); |
250 | is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value'); |
251 | is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value'); |
252 | |
d05cd563 |
253 | =pod |
254 | |
255 | Role override method conflicts |
256 | |
257 | =cut |
258 | |
0558683c |
259 | { |
260 | package Role::Plot; |
261 | use Moose::Role; |
262 | |
263 | override 'twist' => sub { |
264 | super() . ' -> Role::Plot::twist'; |
265 | }; |
266 | |
267 | package Role::Truth; |
268 | use Moose::Role; |
269 | |
270 | override 'twist' => sub { |
271 | super() . ' -> Role::Truth::twist'; |
272 | }; |
273 | } |
274 | |
275 | { |
276 | package My::Test::Base; |
277 | use Moose; |
278 | |
279 | sub twist { 'My::Test::Base::twist' } |
280 | |
281 | package My::Test11; |
282 | use Moose; |
283 | |
284 | extends 'My::Test::Base'; |
285 | |
286 | ::lives_ok { |
287 | with 'Role::Truth'; |
288 | } '... composed the role with override okay'; |
289 | |
290 | package My::Test12; |
291 | use Moose; |
292 | |
293 | extends 'My::Test::Base'; |
294 | |
295 | ::lives_ok { |
296 | with 'Role::Plot'; |
297 | } '... composed the role with override okay'; |
298 | |
299 | package My::Test13; |
300 | use Moose; |
301 | |
302 | ::dies_ok { |
303 | with 'Role::Plot'; |
304 | } '... cannot compose it because we have no superclass'; |
305 | |
306 | package My::Test14; |
307 | use Moose; |
308 | |
309 | extends 'My::Test::Base'; |
310 | |
311 | ::throws_ok { |
312 | with 'Role::Plot', 'Role::Truth'; |
313 | } qr/Two \'override\' methods of the same name encountered/, |
314 | '... cannot compose it because we have no superclass'; |
315 | } |
316 | |
317 | ok(My::Test11->meta->has_method('twist'), '... the twist method has been added'); |
318 | ok(My::Test12->meta->has_method('twist'), '... the twist method has been added'); |
319 | ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added'); |
320 | ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added'); |
321 | |
322 | ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles'); |
323 | ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles'); |
324 | ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles'); |
325 | ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles'); |
326 | ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles'); |
327 | ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles'); |
328 | ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles'); |
329 | |
330 | is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return'); |
331 | is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return'); |
332 | ok(!My::Test13->can('twist'), '... no twist method here at all'); |
333 | is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)'); |
334 | |
335 | { |
336 | package Role::Reality; |
337 | use Moose::Role; |
338 | |
339 | ::throws_ok { |
340 | with 'Role::Plot'; |
341 | } qr/A local method of the same name as been found/, |
342 | '... could not compose roles here, it dies'; |
343 | |
344 | sub twist { |
345 | 'Role::Reality::twist'; |
346 | } |
347 | } |
348 | |
349 | ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added'); |
fb1e11d5 |
350 | #ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles'); |
0558683c |
351 | is(Role::Reality->meta->get_method('twist')->(), |
352 | 'Role::Reality::twist', |
353 | '... the twist method returns the right value'); |
3c5fd53a |
354 | |
355 | =pod |
356 | |
357 | Role conflicts between attributes and methods |
358 | |
21716c07 |
359 | [15:23] <kolibrie> when class defines method and role defines method, class wins |
360 | [15:24] <kolibrie> when class 'has' method and role defines method, class wins |
361 | [15:24] <kolibrie> when class defines method and role 'has' method, role wins |
362 | [15:24] <kolibrie> when class 'has' method and role 'has' method, role wins |
6549b0d1 |
363 | [15:24] <kolibrie> which means when class 'has' method and two roles 'has' method, no tiebreak is detected |
21716c07 |
364 | [15:24] <perigrin> this is with role and has declaration in the exact same order in every case? |
365 | [15:25] <kolibrie> yes |
366 | [15:25] <perigrin> interesting |
367 | [15:25] <kolibrie> that's what I thought |
368 | [15:26] <kolibrie> does that sound like something I should write a test for? |
369 | [15:27] <perigrin> stevan, ping? |
370 | [15:27] <perigrin> I'm not sure what the right answer for composition is. |
371 | [15:27] <perigrin> who should win |
372 | [15:27] <perigrin> if I were to guess I'd say the class should always win. |
373 | [15:27] <kolibrie> that would be my guess, but I thought I would ask to make sure |
374 | [15:29] <stevan> kolibrie: please write a test |
375 | [15:29] <stevan> I am not exactly sure who should win either,.. but I suspect it is not working correctly right now |
376 | [15:29] <stevan> I know exactly why it is doing what it is doing though |
377 | |
378 | Now I have to decide actually what happens, and how to fix it. |
379 | - SL |
3c5fd53a |
380 | |
381 | { |
382 | package Role::Method; |
383 | use Moose::Role; |
384 | |
385 | sub ghost { 'Role::Method::ghost' } |
386 | |
387 | package Role::Method2; |
388 | use Moose::Role; |
389 | |
390 | sub ghost { 'Role::Method2::ghost' } |
391 | |
392 | package Role::Attribute; |
393 | use Moose::Role; |
394 | |
395 | has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost'); |
396 | |
397 | package Role::Attribute2; |
398 | use Moose::Role; |
399 | |
400 | has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost'); |
401 | } |
402 | |
403 | { |
404 | package My::Test15; |
405 | use Moose; |
406 | |
407 | ::lives_ok { |
408 | with 'Role::Method'; |
409 | } '... composed the method role into the method class'; |
410 | |
411 | sub ghost { 'My::Test15::ghost' } |
412 | |
413 | package My::Test16; |
414 | use Moose; |
415 | |
416 | ::lives_ok { |
417 | with 'Role::Method'; |
418 | } '... composed the method role into the attribute class'; |
419 | |
420 | has 'ghost' => (is => 'ro', default => 'My::Test16::ghost'); |
421 | |
422 | package My::Test17; |
423 | use Moose; |
424 | |
425 | ::lives_ok { |
426 | with 'Role::Attribute'; |
427 | } '... composed the attribute role into the method class'; |
428 | |
429 | sub ghost { 'My::Test17::ghost' } |
430 | |
431 | package My::Test18; |
432 | use Moose; |
433 | |
434 | ::lives_ok { |
435 | with 'Role::Attribute'; |
436 | } '... composed the attribute role into the attribute class'; |
437 | |
438 | has 'ghost' => (is => 'ro', default => 'My::Test18::ghost'); |
439 | |
440 | package My::Test19; |
441 | use Moose; |
442 | |
443 | ::lives_ok { |
444 | with 'Role::Method', 'Role::Method2'; |
445 | } '... composed method roles into class with method tiebreaker'; |
446 | |
447 | sub ghost { 'My::Test19::ghost' } |
448 | |
449 | package My::Test20; |
450 | use Moose; |
451 | |
452 | ::lives_ok { |
453 | with 'Role::Method', 'Role::Method2'; |
454 | } '... composed method roles into class with attribute tiebreaker'; |
455 | |
456 | has 'ghost' => (is => 'ro', default => 'My::Test20::ghost'); |
457 | |
458 | package My::Test21; |
459 | use Moose; |
460 | |
461 | ::lives_ok { |
462 | with 'Role::Attribute', 'Role::Attribute2'; |
463 | } '... composed attribute roles into class with method tiebreaker'; |
464 | |
465 | sub ghost { 'My::Test21::ghost' } |
466 | |
467 | package My::Test22; |
468 | use Moose; |
469 | |
470 | ::lives_ok { |
471 | with 'Role::Attribute', 'Role::Attribute2'; |
472 | } '... composed attribute roles into class with attribute tiebreaker'; |
473 | |
474 | has 'ghost' => (is => 'ro', default => 'My::Test22::ghost'); |
475 | |
476 | package My::Test23; |
477 | use Moose; |
478 | |
479 | ::lives_ok { |
480 | with 'Role::Method', 'Role::Attribute'; |
481 | } '... composed method and attribute role into class with method tiebreaker'; |
482 | |
483 | sub ghost { 'My::Test23::ghost' } |
484 | |
485 | package My::Test24; |
486 | use Moose; |
487 | |
488 | ::lives_ok { |
489 | with 'Role::Method', 'Role::Attribute'; |
490 | } '... composed method and attribute role into class with attribute tiebreaker'; |
491 | |
492 | has 'ghost' => (is => 'ro', default => 'My::Test24::ghost'); |
493 | |
494 | package My::Test25; |
495 | use Moose; |
496 | |
497 | ::lives_ok { |
498 | with 'Role::Attribute', 'Role::Method'; |
499 | } '... composed attribute and method role into class with method tiebreaker'; |
500 | |
501 | sub ghost { 'My::Test25::ghost' } |
502 | |
503 | package My::Test26; |
504 | use Moose; |
505 | |
506 | ::lives_ok { |
507 | with 'Role::Attribute', 'Role::Method'; |
508 | } '... composed attribute and method role into class with attribute tiebreaker'; |
509 | |
510 | has 'ghost' => (is => 'ro', default => 'My::Test26::ghost'); |
511 | } |
512 | |
513 | my $test15 = My::Test15->new; |
514 | isa_ok($test15, 'My::Test15'); |
515 | is($test15->ghost, 'My::Test15::ghost', '... we access the method from the class and ignore the role method'); |
516 | |
517 | my $test16 = My::Test16->new; |
518 | isa_ok($test16, 'My::Test16'); |
519 | is($test16->ghost, 'My::Test16::ghost', '... we access the attribute from the class and ignore the role method'); |
520 | |
521 | my $test17 = My::Test17->new; |
522 | isa_ok($test17, 'My::Test17'); |
523 | is($test17->ghost, 'My::Test17::ghost', '... we access the method from the class and ignore the role attribute'); |
524 | |
525 | my $test18 = My::Test18->new; |
526 | isa_ok($test18, 'My::Test18'); |
527 | is($test18->ghost, 'My::Test18::ghost', '... we access the attribute from the class and ignore the role attribute'); |
528 | |
529 | my $test19 = My::Test19->new; |
530 | isa_ok($test19, 'My::Test19'); |
531 | is($test19->ghost, 'My::Test19::ghost', '... we access the method from the class and ignore the role methods'); |
532 | |
533 | my $test20 = My::Test20->new; |
534 | isa_ok($test20, 'My::Test20'); |
535 | is($test20->ghost, 'My::Test20::ghost', '... we access the attribute from the class and ignore the role methods'); |
536 | |
537 | my $test21 = My::Test21->new; |
538 | isa_ok($test21, 'My::Test21'); |
539 | is($test21->ghost, 'My::Test21::ghost', '... we access the method from the class and ignore the role attributes'); |
540 | |
541 | my $test22 = My::Test22->new; |
542 | isa_ok($test22, 'My::Test22'); |
543 | is($test22->ghost, 'My::Test22::ghost', '... we access the attribute from the class and ignore the role attributes'); |
544 | |
545 | my $test23 = My::Test23->new; |
546 | isa_ok($test23, 'My::Test23'); |
547 | is($test23->ghost, 'My::Test23::ghost', '... we access the method from the class and ignore the role method and attribute'); |
548 | |
549 | my $test24 = My::Test24->new; |
550 | isa_ok($test24, 'My::Test24'); |
551 | is($test24->ghost, 'My::Test24::ghost', '... we access the attribute from the class and ignore the role method and attribute'); |
552 | |
553 | my $test25 = My::Test25->new; |
554 | isa_ok($test25, 'My::Test25'); |
555 | is($test25->ghost, 'My::Test25::ghost', '... we access the method from the class and ignore the role attribute and method'); |
556 | |
557 | my $test26 = My::Test26->new; |
558 | isa_ok($test26, 'My::Test26'); |
559 | is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method'); |
560 | |
21716c07 |
561 | =cut |