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