t/044_basic_role_composition.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More no_plan => 1;
   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 is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
 162 is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
 163 is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
 164
 165 # check how this affects role compostion
 166
 167 {
 168     package Role::Bling::Bling::Bling;
 169     use strict;
 170     use warnings;
 171     use Moose::Role;
 172
 173     with 'Role::Bling::Bling';
 174
 175     sub bling { 'Role::Bling::Bling::Bling::bling' }
 176 }
 177
 178 ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
 179 ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
 180
 181 =pod
 182
 183 Role attribute conflicts
 184
 185 =cut
 186
 187 {
 188     package Role::Boo;
 189     use strict;
 190     use warnings;
 191     use Moose::Role;
 192
 193     has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
 194
 195     package Role::Boo::Hoo;
 196     use strict;
 197     use warnings;
 198     use Moose::Role;
 199
 200     has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
 201 }
 202
 203 {
 204     package My::Test7;
 205     use strict;
 206     use warnings;
 207     use Moose;
 208
 209     ::throws_ok {
 210         with 'Role::Boo', 'Role::Boo::Hoo';
 211     } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
 212       '... role attrs conflicted and method was required';
 213
 214     package My::Test8;
 215     use strict;
 216     use warnings;
 217     use Moose;
 218
 219     ::lives_ok {
 220         with 'Role::Boo';
 221         with 'Role::Boo::Hoo';
 222     } '... role attrs didnt conflict when manually combined';
 223
 224     package My::Test9;
 225     use strict;
 226     use warnings;
 227     use Moose;
 228
 229     ::lives_ok {
 230         with 'Role::Boo::Hoo';
 231         with 'Role::Boo';
 232     } '... role attrs didnt conflict when manually combined';
 233
 234     package My::Test10;
 235     use strict;
 236     use warnings;
 237     use Moose;
 238
 239     has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
 240
 241     ::throws_ok {
 242         with 'Role::Boo', 'Role::Boo::Hoo';
 243     } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
 244       '... role attrs conflicted and cannot be manually disambiguted';
 245
 246 }
 247
 248 ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
 249 ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
 250 ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
 251 ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
 252
 253 can_ok('My::Test8', 'ghost');
 254 can_ok('My::Test9', 'ghost');
 255 can_ok('My::Test10', 'ghost');
 256
 257 is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
 258 is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
 259 is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
 260
 261
 262