t/030_roles/failing/005_role_conflict_detection.t

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