t/030_roles/005_role_conflict_detection.t

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