t/roles/role_conflict_detection.t

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