t/030_roles/005_role_conflict_detection.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 89;
   7 use Test::Exception;
   8 use Test::Output;
   9
  10 =pod
  11
  12 Mutually recursive roles.
  13
  14 =cut
  15
  16 {
  17     package Role::Foo;
  18     use Moose::Role;
  19
  20     requires 'foo';
  21
  22     sub bar { 'Role::Foo::bar' }
  23
  24     package Role::Bar;
  25     use Moose::Role;
  26
  27     requires 'bar';
  28
  29     sub foo { 'Role::Bar::foo' }
  30 }
  31
  32 {
  33     package My::Test1;
  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;
  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;
  88     use Moose::Role;
  89
  90     sub bling { 'Role::Bling::bling' }
  91
  92     package Role::Bling::Bling;
  93     use Moose::Role;
  94
  95     sub bling { 'Role::Bling::Bling::bling' }
  96 }
  97
  98 {
  99     package My::Test3;
 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;
 107     use Moose;
 108
 109     ::lives_ok {
 110         with 'Role::Bling';
 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
 116     } '... role methods didnt conflict when manually combined';
 117
 118     package My::Test5;
 119     use Moose;
 120
 121     ::lives_ok {
 122         with 'Role::Bling::Bling';
 123
 124         ::stderr_like {
 125             with 'Role::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)';
 128
 129     package My::Test6;
 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
 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
 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;
 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');
 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');
 174
 175
 176 =pod
 177
 178 Role attribute conflicts
 179
 180 =cut
 181
 182 {
 183     package Role::Boo;
 184     use Moose::Role;
 185
 186     has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
 187
 188     package Role::Boo::Hoo;
 189     use Moose::Role;
 190
 191     has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
 192 }
 193
 194 {
 195     package My::Test7;
 196     use Moose;
 197
 198     ::throws_ok {
 199         with 'Role::Boo', 'Role::Boo::Hoo';
 200     } qr/We have encountered an attribute conflict/,
 201       '... role attrs conflicted and method was required';
 202
 203     package My::Test8;
 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;
 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;
 220     use Moose;
 221
 222     has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
 223
 224     ::throws_ok {
 225         with 'Role::Boo', 'Role::Boo::Hoo';
 226     } qr/We have encountered an attribute conflict/,
 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
 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
 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
 253 =pod
 254
 255 Role override method conflicts
 256
 257 =cut
 258
 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');
 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');
 354
 355 =pod
 356
 357 Role conflicts between attributes and methods
 358
 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
 377
 378 Now I have to decide actually what happens, and how to fix it.
 379 - SL
 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
 561 =cut