6 use Test::More tests => 89;
12 Mutually recursive roles.
22 sub bar { 'Role::Foo::bar' }
29 sub foo { 'Role::Bar::foo' }
37 with 'Role::Foo', 'Role::Bar';
38 } '... our mutually recursive roles combine okay';
44 with 'Role::Bar', 'Role::Foo';
45 } '... our mutually recursive roles combine okay (no matter what order)';
48 my $test1 = My::Test1->new;
49 isa_ok($test1, 'My::Test1');
51 ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
52 ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
54 can_ok($test1, 'foo');
55 can_ok($test1, 'bar');
57 is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
58 is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
60 my $test2 = My::Test2->new;
61 isa_ok($test2, 'My::Test2');
63 ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
64 ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
66 can_ok($test2, 'foo');
67 can_ok($test2, 'bar');
69 is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
70 is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
72 # check some meta-stuff
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');
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');
90 sub bling { 'Role::Bling::bling' }
92 package Role::Bling::Bling;
95 sub bling { 'Role::Bling::Bling::bling' }
103 with 'Role::Bling', 'Role::Bling::Bling';
104 } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
113 with 'Role::Bling::Bling';
114 } qr/The My::Test4 class has implicitly overridden the method \(bling\) from role Role::Bling::Bling\./;
116 } '... role methods didnt conflict when manually combined';
122 with 'Role::Bling::Bling';
126 } qr/The My::Test5 class has implicitly overridden the method \(bling\) from role Role::Bling\./;
127 } '... role methods didnt conflict when manually combined (in opposite order)';
133 with 'Role::Bling::Bling', 'Role::Bling';
134 } '... role methods didnt conflict when manually resolved';
136 sub bling { 'My::Test6::bling' }
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');
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');
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');
157 # check how this affects role compostion
160 package Role::Bling::Bling::Bling;
163 with 'Role::Bling::Bling';
165 sub bling { 'Role::Bling::Bling::Bling::bling' }
168 ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
169 ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
170 ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have the bling method in Role::Bling::Bling::Bling');
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');
178 Role attribute conflicts
186 has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
188 package Role::Boo::Hoo;
191 has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
199 with 'Role::Boo', 'Role::Boo::Hoo';
200 } qr/We have encountered an attribute conflict/,
201 '... role attrs conflicted and method was required';
208 with 'Role::Boo::Hoo';
209 } '... role attrs didnt conflict when manually combined';
215 with 'Role::Boo::Hoo';
217 } '... role attrs didnt conflict when manually combined';
222 has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
225 with 'Role::Boo', 'Role::Boo::Hoo';
226 } qr/We have encountered an attribute conflict/,
227 '... role attrs conflicted and cannot be manually disambiguted';
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)');
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');
245 can_ok('My::Test8', 'ghost');
246 can_ok('My::Test9', 'ghost');
247 can_ok('My::Test10', 'ghost');
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');
255 Role override method conflicts
263 override 'twist' => sub {
264 super() . ' -> Role::Plot::twist';
270 override 'twist' => sub {
271 super() . ' -> Role::Truth::twist';
276 package My::Test::Base;
279 sub twist { 'My::Test::Base::twist' }
284 extends 'My::Test::Base';
288 } '... composed the role with override okay';
293 extends 'My::Test::Base';
297 } '... composed the role with override okay';
304 } '... cannot compose it because we have no superclass';
309 extends 'My::Test::Base';
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';
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');
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');
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)');
336 package Role::Reality;
341 } qr/A local method of the same name as been found/,
342 '... could not compose roles here, it dies';
345 'Role::Reality::twist';
349 ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
350 #ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
351 is(Role::Reality->meta->get_method('twist')->(),
352 'Role::Reality::twist',
353 '... the twist method returns the right value');
357 Role conflicts between attributes and methods
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
363 [15:24] <kolibrie> which means when class 'has' method and two roles 'has' method, no tiebreak is detected
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
378 Now I have to decide actually what happens, and how to fix it.
382 package Role::Method;
385 sub ghost { 'Role::Method::ghost' }
387 package Role::Method2;
390 sub ghost { 'Role::Method2::ghost' }
392 package Role::Attribute;
395 has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost');
397 package Role::Attribute2;
400 has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost');
409 } '... composed the method role into the method class';
411 sub ghost { 'My::Test15::ghost' }
418 } '... composed the method role into the attribute class';
420 has 'ghost' => (is => 'ro', default => 'My::Test16::ghost');
426 with 'Role::Attribute';
427 } '... composed the attribute role into the method class';
429 sub ghost { 'My::Test17::ghost' }
435 with 'Role::Attribute';
436 } '... composed the attribute role into the attribute class';
438 has 'ghost' => (is => 'ro', default => 'My::Test18::ghost');
444 with 'Role::Method', 'Role::Method2';
445 } '... composed method roles into class with method tiebreaker';
447 sub ghost { 'My::Test19::ghost' }
453 with 'Role::Method', 'Role::Method2';
454 } '... composed method roles into class with attribute tiebreaker';
456 has 'ghost' => (is => 'ro', default => 'My::Test20::ghost');
462 with 'Role::Attribute', 'Role::Attribute2';
463 } '... composed attribute roles into class with method tiebreaker';
465 sub ghost { 'My::Test21::ghost' }
471 with 'Role::Attribute', 'Role::Attribute2';
472 } '... composed attribute roles into class with attribute tiebreaker';
474 has 'ghost' => (is => 'ro', default => 'My::Test22::ghost');
480 with 'Role::Method', 'Role::Attribute';
481 } '... composed method and attribute role into class with method tiebreaker';
483 sub ghost { 'My::Test23::ghost' }
489 with 'Role::Method', 'Role::Attribute';
490 } '... composed method and attribute role into class with attribute tiebreaker';
492 has 'ghost' => (is => 'ro', default => 'My::Test24::ghost');
498 with 'Role::Attribute', 'Role::Method';
499 } '... composed attribute and method role into class with method tiebreaker';
501 sub ghost { 'My::Test25::ghost' }
507 with 'Role::Attribute', 'Role::Method';
508 } '... composed attribute and method role into class with attribute tiebreaker';
510 has 'ghost' => (is => 'ro', default => 'My::Test26::ghost');
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');
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');
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');
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');
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');
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');
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');
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');
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');
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');
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');
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');