t/044_role_conflict_detection.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 90;
   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 strict;
  23     use warnings;
  24     use Moose::Role;
  25
  26     requires 'foo';
  27
  28     sub bar { 'Role::Foo::bar' }
  29
  30     package Role::Bar;
  31     use strict;
  32     use warnings;
  33     use Moose::Role;
  34
  35     requires 'bar';
  36
  37     sub foo { 'Role::Bar::foo' }
  38 }
  39
  40 {
  41     package My::Test1;
  42     use strict;
  43     use warnings;
  44     use Moose;
  45
  46     ::lives_ok {
  47         with 'Role::Foo', 'Role::Bar';
  48     } '... our mutually recursive roles combine okay';
  49
  50     package My::Test2;
  51     use strict;
  52     use warnings;
  53     use Moose;
  54
  55     ::lives_ok {
  56         with 'Role::Bar', 'Role::Foo';
  57     } '... our mutually recursive roles combine okay (no matter what order)';
  58 }
  59
  60 my $test1 = My::Test1->new;
  61 isa_ok($test1, 'My::Test1');
  62
  63 ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
  64 ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
  65
  66 can_ok($test1, 'foo');
  67 can_ok($test1, 'bar');
  68
  69 is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
  70 is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
  71
  72 my $test2 = My::Test2->new;
  73 isa_ok($test2, 'My::Test2');
  74
  75 ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
  76 ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
  77
  78 can_ok($test2, 'foo');
  79 can_ok($test2, 'bar');
  80
  81 is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
  82 is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
  83
  84 # check some meta-stuff
  85
  86 ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
  87 ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
  88
  89 ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
  90 ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
  91
  92 =pod
  93
  94 Role method conflicts
  95
  96 =cut
  97
  98 {
  99     package Role::Bling;
 100     use strict;
 101     use warnings;
 102     use Moose::Role;
 103
 104     sub bling { 'Role::Bling::bling' }
 105
 106     package Role::Bling::Bling;
 107     use strict;
 108     use warnings;
 109     use Moose::Role;
 110
 111     sub bling { 'Role::Bling::Bling::bling' }
 112 }
 113
 114 {
 115     package My::Test3;
 116     use strict;
 117     use warnings;
 118     use Moose;
 119
 120     ::throws_ok {
 121         with 'Role::Bling', 'Role::Bling::Bling';
 122     } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
 123
 124     package My::Test4;
 125     use strict;
 126     use warnings;
 127     use Moose;
 128
 129     ::lives_ok {
 130         with 'Role::Bling';
 131         with 'Role::Bling::Bling';
 132     } '... role methods didnt conflict when manually combined';
 133
 134     package My::Test5;
 135     use strict;
 136     use warnings;
 137     use Moose;
 138
 139     ::lives_ok {
 140         with 'Role::Bling::Bling';
 141         with 'Role::Bling';
 142     } '... role methods didnt conflict when manually combined (in opposite order)';
 143
 144     package My::Test6;
 145     use strict;
 146     use warnings;
 147     use Moose;
 148
 149     ::lives_ok {
 150         with 'Role::Bling::Bling', 'Role::Bling';
 151     } '... role methods didnt conflict when manually resolved';
 152
 153     sub bling { 'My::Test6::bling' }
 154 }
 155
 156 ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
 157 ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
 158 ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
 159 ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
 160
 161 ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
 162 ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
 163 ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles');
 164 ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles');
 165 ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles');
 166 ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles');
 167 ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles');
 168 ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles');
 169
 170 is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
 171 is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
 172 is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
 173
 174 # check how this affects role compostion
 175
 176 {
 177     package Role::Bling::Bling::Bling;
 178     use strict;
 179     use warnings;
 180     use Moose::Role;
 181
 182     with 'Role::Bling::Bling';
 183
 184     sub bling { 'Role::Bling::Bling::Bling::bling' }
 185 }
 186
 187 ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
 188 ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
 189 ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
 190 is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
 191     'Role::Bling::Bling::Bling::bling',
 192     '... still got the bling method in Role::Bling::Bling::Bling');
 193
 194 =pod
 195
 196 Role attribute conflicts
 197
 198 =cut
 199
 200 {
 201     package Role::Boo;
 202     use strict;
 203     use warnings;
 204     use Moose::Role;
 205
 206     has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
 207
 208     package Role::Boo::Hoo;
 209     use strict;
 210     use warnings;
 211     use Moose::Role;
 212
 213     has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
 214 }
 215
 216 {
 217     package My::Test7;
 218     use strict;
 219     use warnings;
 220     use Moose;
 221
 222     ::throws_ok {
 223         with 'Role::Boo', 'Role::Boo::Hoo';
 224     } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
 225       '... role attrs conflicted and method was required';
 226
 227     package My::Test8;
 228     use strict;
 229     use warnings;
 230     use Moose;
 231
 232     ::lives_ok {
 233         with 'Role::Boo';
 234         with 'Role::Boo::Hoo';
 235     } '... role attrs didnt conflict when manually combined';
 236
 237     package My::Test9;
 238     use strict;
 239     use warnings;
 240     use Moose;
 241
 242     ::lives_ok {
 243         with 'Role::Boo::Hoo';
 244         with 'Role::Boo';
 245     } '... role attrs didnt conflict when manually combined';
 246
 247     package My::Test10;
 248     use strict;
 249     use warnings;
 250     use Moose;
 251
 252     has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
 253
 254     ::throws_ok {
 255         with 'Role::Boo', 'Role::Boo::Hoo';
 256     } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
 257       '... role attrs conflicted and cannot be manually disambiguted';
 258
 259 }
 260
 261 ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
 262 ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
 263 ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
 264 ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
 265
 266 ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles');
 267 ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles');
 268 ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles');
 269 ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles');
 270 ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles');
 271 ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles');
 272 ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles');
 273 ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles');
 274
 275 can_ok('My::Test8', 'ghost');
 276 can_ok('My::Test9', 'ghost');
 277 can_ok('My::Test10', 'ghost');
 278
 279 is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
 280 is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
 281 is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
 282
 283 =pod
 284
 285 Role override method conflicts
 286
 287 =cut
 288
 289 {
 290     package Role::Plot;
 291     use strict;
 292     use warnings;
 293     use Moose::Role;
 294
 295     override 'twist' => sub {
 296         super() . ' -> Role::Plot::twist';
 297     };
 298
 299     package Role::Truth;
 300     use strict;
 301     use warnings;
 302     use Moose::Role;
 303
 304     override 'twist' => sub {
 305         super() . ' -> Role::Truth::twist';
 306     };
 307 }
 308
 309 {
 310     package My::Test::Base;
 311     use strict;
 312     use warnings;
 313     use Moose;
 314
 315     sub twist { 'My::Test::Base::twist' }
 316
 317     package My::Test11;
 318     use strict;
 319     use warnings;
 320     use Moose;
 321
 322     extends 'My::Test::Base';
 323
 324     ::lives_ok {
 325         with 'Role::Truth';
 326     } '... composed the role with override okay';
 327
 328     package My::Test12;
 329     use strict;
 330     use warnings;
 331     use Moose;
 332
 333     extends 'My::Test::Base';
 334
 335     ::lives_ok {
 336        with 'Role::Plot';
 337     } '... composed the role with override okay';
 338
 339     package My::Test13;
 340     use strict;
 341     use warnings;
 342     use Moose;
 343
 344     ::dies_ok {
 345         with 'Role::Plot';
 346     } '... cannot compose it because we have no superclass';
 347
 348     package My::Test14;
 349     use strict;
 350     use warnings;
 351     use Moose;
 352
 353     extends 'My::Test::Base';
 354
 355     ::throws_ok {
 356         with 'Role::Plot', 'Role::Truth';
 357     } qr/Two \'override\' methods of the same name encountered/,
 358       '... cannot compose it because we have no superclass';
 359 }
 360
 361 ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
 362 ok(My::Test12->meta->has_method('twist'), '... the twist method has been added');
 363 ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added');
 364 ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added');
 365
 366 ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles');
 367 ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles');
 368 ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles');
 369 ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles');
 370 ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles');
 371 ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles');
 372 ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles');
 373
 374 is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return');
 375 is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return');
 376 ok(!My::Test13->can('twist'), '... no twist method here at all');
 377 is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)');
 378
 379 {
 380     package Role::Reality;
 381     use strict;
 382     use warnings;
 383     use Moose::Role;
 384
 385     ::throws_ok {
 386         with 'Role::Plot';
 387     } qr/A local method of the same name as been found/,
 388     '... could not compose roles here, it dies';
 389
 390     sub twist {
 391         'Role::Reality::twist';
 392     }
 393 }
 394
 395 ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
 396 ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
 397 is(Role::Reality->meta->get_method('twist')->(),
 398     'Role::Reality::twist',
 399     '... the twist method returns the right value');