11 Mutually recursive roles.
21 sub bar { 'Role::Foo::bar' }
28 sub foo { 'Role::Bar::foo' }
36 with 'Role::Foo', 'Role::Bar';
37 }, undef, '... our mutually recursive roles combine okay' );
43 with 'Role::Bar', 'Role::Foo';
44 }, undef, '... our mutually recursive roles combine okay (no matter what order)' );
47 my $test1 = My::Test1->new;
48 isa_ok($test1, 'My::Test1');
50 ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
51 ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
53 can_ok($test1, 'foo');
54 can_ok($test1, 'bar');
56 is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
57 is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
59 my $test2 = My::Test2->new;
60 isa_ok($test2, 'My::Test2');
62 ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
63 ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
65 can_ok($test2, 'foo');
66 can_ok($test2, 'bar');
68 is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
69 is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
71 # check some meta-stuff
73 ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
74 ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
76 ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
77 ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
89 sub bling { 'Role::Bling::bling' }
91 package Role::Bling::Bling;
94 sub bling { 'Role::Bling::Bling::bling' }
101 ::like( ::exception {
102 with 'Role::Bling', 'Role::Bling::Bling';
103 }, qr/Due to a method name conflict in roles 'Role::Bling' and 'Role::Bling::Bling', the method 'bling' must be implemented or excluded by 'My::Test3'/, '... role methods conflict and method was required' );
110 with 'Role::Bling::Bling';
111 }, undef, '... role methods didnt conflict when manually combined' );
117 with 'Role::Bling::Bling';
119 }, undef, '... role methods didnt conflict when manually combined (in opposite order)' );
125 with 'Role::Bling::Bling', 'Role::Bling';
126 }, undef, '... role methods didnt conflict when manually resolved' );
128 sub bling { 'My::Test6::bling' }
131 ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
132 ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
133 ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
134 ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
136 ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
137 ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
138 ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles');
139 ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles');
140 ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles');
141 ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles');
142 ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles');
143 ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles');
145 is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
146 is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
147 is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
149 # check how this affects role compostion
152 package Role::Bling::Bling::Bling;
155 with 'Role::Bling::Bling';
157 sub bling { 'Role::Bling::Bling::Bling::bling' }
160 ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
161 ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
162 ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have the bling method in Role::Bling::Bling::Bling');
163 is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
164 'Role::Bling::Bling::Bling::bling',
165 '... still got the bling method in Role::Bling::Bling::Bling');
170 Role attribute conflicts
178 has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
180 package Role::Boo::Hoo;
183 has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
190 ::like( ::exception {
191 with 'Role::Boo', 'Role::Boo::Hoo';
192 }, qr/We have encountered an attribute conflict.+ghost/ );
199 with 'Role::Boo::Hoo';
200 }, undef, '... role attrs didnt conflict when manually combined' );
206 with 'Role::Boo::Hoo';
208 }, undef, '... role attrs didnt conflict when manually combined' );
213 has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
215 ::like( ::exception {
216 with 'Role::Boo', 'Role::Boo::Hoo';
217 }, qr/We have encountered an attribute conflict/, '... role attrs conflict and cannot be manually disambiguted' );
221 ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
222 ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
223 ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
224 ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
226 ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles');
227 ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles');
228 ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles');
229 ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles');
230 ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles');
231 ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles');
232 ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles');
233 ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles');
235 can_ok('My::Test8', 'ghost');
236 can_ok('My::Test9', 'ghost');
237 can_ok('My::Test10', 'ghost');
239 is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
240 is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
241 is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
245 Role override method conflicts
253 override 'twist' => sub {
254 super() . ' -> Role::Plot::twist';
260 override 'twist' => sub {
261 super() . ' -> Role::Truth::twist';
266 package My::Test::Base;
269 sub twist { 'My::Test::Base::twist' }
274 extends 'My::Test::Base';
278 }, undef, '... composed the role with override okay' );
283 extends 'My::Test::Base';
287 }, undef, '... composed the role with override okay' );
292 ::isnt( ::exception {
294 }, undef, '... cannot compose it because we have no superclass' );
299 extends 'My::Test::Base';
301 ::like( ::exception {
302 with 'Role::Plot', 'Role::Truth';
303 }, qr/Two \'override\' methods of the same name encountered/, '... cannot compose it because we have no superclass' );
306 ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
307 ok(My::Test12->meta->has_method('twist'), '... the twist method has been added');
308 ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added');
309 ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added');
311 ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles');
312 ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles');
313 ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles');
314 ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles');
315 ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles');
316 ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles');
317 ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles');
319 is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return');
320 is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return');
321 ok(!My::Test13->can('twist'), '... no twist method here at all');
322 is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)');
325 package Role::Reality;
328 ::like( ::exception {
330 }, qr/A local method of the same name as been found/, '... could not compose roles here, it dies' );
333 'Role::Reality::twist';
337 ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
338 #ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
339 is(Role::Reality->meta->get_method('twist')->(),
340 'Role::Reality::twist',
341 '... the twist method returns the right value');
343 # Ovid's test case from rt.cpan.org #44
360 ::like( ::exception {
361 with qw(Role1 Role2);
362 }, qr/Due to a method name conflict in roles 'Role1' and 'Role2', the method 'foo' must be implemented or excluded by 'Conflicts'/ );
367 Role conflicts between attributes and methods
369 [15:23] <kolibrie> when class defines method and role defines method, class wins
370 [15:24] <kolibrie> when class 'has' method and role defines method, class wins
371 [15:24] <kolibrie> when class defines method and role 'has' method, role wins
372 [15:24] <kolibrie> when class 'has' method and role 'has' method, role wins
373 [15:24] <kolibrie> which means when class 'has' method and two roles 'has' method, no tiebreak is detected
374 [15:24] <perigrin> this is with role and has declaration in the exact same order in every case?
375 [15:25] <kolibrie> yes
376 [15:25] <perigrin> interesting
377 [15:25] <kolibrie> that's what I thought
378 [15:26] <kolibrie> does that sound like something I should write a test for?
379 [15:27] <perigrin> stevan, ping?
380 [15:27] <perigrin> I'm not sure what the right answer for composition is.
381 [15:27] <perigrin> who should win
382 [15:27] <perigrin> if I were to guess I'd say the class should always win.
383 [15:27] <kolibrie> that would be my guess, but I thought I would ask to make sure
384 [15:29] <stevan> kolibrie: please write a test
385 [15:29] <stevan> I am not exactly sure who should win either,.. but I suspect it is not working correctly right now
386 [15:29] <stevan> I know exactly why it is doing what it is doing though
388 Now I have to decide actually what happens, and how to fix it.
392 package Role::Method;
395 sub ghost { 'Role::Method::ghost' }
397 package Role::Method2;
400 sub ghost { 'Role::Method2::ghost' }
402 package Role::Attribute;
405 has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost');
407 package Role::Attribute2;
410 has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost');
419 } '... composed the method role into the method class';
421 sub ghost { 'My::Test15::ghost' }
428 } '... composed the method role into the attribute class';
430 has 'ghost' => (is => 'ro', default => 'My::Test16::ghost');
436 with 'Role::Attribute';
437 } '... composed the attribute role into the method class';
439 sub ghost { 'My::Test17::ghost' }
445 with 'Role::Attribute';
446 } '... composed the attribute role into the attribute class';
448 has 'ghost' => (is => 'ro', default => 'My::Test18::ghost');
454 with 'Role::Method', 'Role::Method2';
455 } '... composed method roles into class with method tiebreaker';
457 sub ghost { 'My::Test19::ghost' }
463 with 'Role::Method', 'Role::Method2';
464 } '... composed method roles into class with attribute tiebreaker';
466 has 'ghost' => (is => 'ro', default => 'My::Test20::ghost');
472 with 'Role::Attribute', 'Role::Attribute2';
473 } '... composed attribute roles into class with method tiebreaker';
475 sub ghost { 'My::Test21::ghost' }
481 with 'Role::Attribute', 'Role::Attribute2';
482 } '... composed attribute roles into class with attribute tiebreaker';
484 has 'ghost' => (is => 'ro', default => 'My::Test22::ghost');
490 with 'Role::Method', 'Role::Attribute';
491 } '... composed method and attribute role into class with method tiebreaker';
493 sub ghost { 'My::Test23::ghost' }
499 with 'Role::Method', 'Role::Attribute';
500 } '... composed method and attribute role into class with attribute tiebreaker';
502 has 'ghost' => (is => 'ro', default => 'My::Test24::ghost');
508 with 'Role::Attribute', 'Role::Method';
509 } '... composed attribute and method role into class with method tiebreaker';
511 sub ghost { 'My::Test25::ghost' }
517 with 'Role::Attribute', 'Role::Method';
518 } '... composed attribute and method role into class with attribute tiebreaker';
520 has 'ghost' => (is => 'ro', default => 'My::Test26::ghost');
523 my $test15 = My::Test15->new;
524 isa_ok($test15, 'My::Test15');
525 is($test15->ghost, 'My::Test15::ghost', '... we access the method from the class and ignore the role method');
527 my $test16 = My::Test16->new;
528 isa_ok($test16, 'My::Test16');
529 is($test16->ghost, 'My::Test16::ghost', '... we access the attribute from the class and ignore the role method');
531 my $test17 = My::Test17->new;
532 isa_ok($test17, 'My::Test17');
533 is($test17->ghost, 'My::Test17::ghost', '... we access the method from the class and ignore the role attribute');
535 my $test18 = My::Test18->new;
536 isa_ok($test18, 'My::Test18');
537 is($test18->ghost, 'My::Test18::ghost', '... we access the attribute from the class and ignore the role attribute');
539 my $test19 = My::Test19->new;
540 isa_ok($test19, 'My::Test19');
541 is($test19->ghost, 'My::Test19::ghost', '... we access the method from the class and ignore the role methods');
543 my $test20 = My::Test20->new;
544 isa_ok($test20, 'My::Test20');
545 is($test20->ghost, 'My::Test20::ghost', '... we access the attribute from the class and ignore the role methods');
547 my $test21 = My::Test21->new;
548 isa_ok($test21, 'My::Test21');
549 is($test21->ghost, 'My::Test21::ghost', '... we access the method from the class and ignore the role attributes');
551 my $test22 = My::Test22->new;
552 isa_ok($test22, 'My::Test22');
553 is($test22->ghost, 'My::Test22::ghost', '... we access the attribute from the class and ignore the role attributes');
555 my $test23 = My::Test23->new;
556 isa_ok($test23, 'My::Test23');
557 is($test23->ghost, 'My::Test23::ghost', '... we access the method from the class and ignore the role method and attribute');
559 my $test24 = My::Test24->new;
560 isa_ok($test24, 'My::Test24');
561 is($test24->ghost, 'My::Test24::ghost', '... we access the attribute from the class and ignore the role method and attribute');
563 my $test25 = My::Test25->new;
564 isa_ok($test25, 'My::Test25');
565 is($test25->ghost, 'My::Test25::ghost', '... we access the method from the class and ignore the role attribute and method');
567 my $test26 = My::Test26->new;
568 isa_ok($test26, 'My::Test26');
569 is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method');