t/030_roles/011_overriding.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9
  10 {
  11     # test no conflicts here
  12     package Role::A;
  13     use Moose::Role;
  14
  15     sub bar { 'Role::A::bar' }
  16
  17     package Role::B;
  18     use Moose::Role;
  19
  20     sub xxy { 'Role::B::xxy' }
  21
  22     package Role::C;
  23     use Moose::Role;
  24
  25     ::is( ::exception {
  26         with qw(Role::A Role::B); # no conflict here
  27     }, undef, "define role C" );
  28
  29     sub foo { 'Role::C::foo' }
  30     sub zot { 'Role::C::zot' }
  31
  32     package Class::A;
  33     use Moose;
  34
  35     ::is( ::exception {
  36         with qw(Role::C);
  37     }, undef, "define class A" );
  38
  39     sub zot { 'Class::A::zot' }
  40 }
  41
  42 can_ok( Class::A->new, qw(foo bar xxy zot) );
  43
  44 is( Class::A->new->foo, "Role::C::foo",  "... got the right foo method" );
  45 is( Class::A->new->zot, "Class::A::zot", "... got the right zot method" );
  46 is( Class::A->new->bar, "Role::A::bar",  "... got the right bar method" );
  47 is( Class::A->new->xxy, "Role::B::xxy",  "... got the right xxy method" );
  48
  49 {
  50     # check that when a role is added to another role
  51     # and they conflict and the method they conflict
  52     # with is then required.
  53
  54     package Role::A::Conflict;
  55     use Moose::Role;
  56
  57     with 'Role::A';
  58
  59     sub bar { 'Role::A::Conflict::bar' }
  60
  61     package Class::A::Conflict;
  62     use Moose;
  63
  64     ::like( ::exception {
  65         with 'Role::A::Conflict';
  66     }, qr/Due to a method name conflict in roles 'Role::A' and 'Role::A::Conflict', the method 'bar' must be implemented or excluded by 'Class::A::Conflict'/, '... did not fufill the requirement of &bar method' );
  67
  68     package Class::A::Resolved;
  69     use Moose;
  70
  71     ::is( ::exception {
  72         with 'Role::A::Conflict';
  73     }, undef, '... did fufill the requirement of &bar method' );
  74
  75     sub bar { 'Class::A::Resolved::bar' }
  76 }
  77
  78 ok(Role::A::Conflict->meta->requires_method('bar'), '... Role::A::Conflict created the bar requirement');
  79
  80 can_ok( Class::A::Resolved->new, qw(bar) );
  81
  82 is( Class::A::Resolved->new->bar, 'Class::A::Resolved::bar', "... got the right bar method" );
  83
  84 {
  85     # check that when two roles are composed, they conflict
  86     # but the composing role can resolve that conflict
  87
  88     package Role::D;
  89     use Moose::Role;
  90
  91     sub foo { 'Role::D::foo' }
  92     sub bar { 'Role::D::bar' }
  93
  94     package Role::E;
  95     use Moose::Role;
  96
  97     sub foo { 'Role::E::foo' }
  98     sub xxy { 'Role::E::xxy' }
  99
 100     package Role::F;
 101     use Moose::Role;
 102
 103     ::is( ::exception {
 104         with qw(Role::D Role::E); # conflict between 'foo's here
 105     }, undef, "define role Role::F" );
 106
 107     sub foo { 'Role::F::foo' }
 108     sub zot { 'Role::F::zot' }
 109
 110     package Class::B;
 111     use Moose;
 112
 113     ::is( ::exception {
 114         with qw(Role::F);
 115     }, undef, "define class Class::B" );
 116
 117     sub zot { 'Class::B::zot' }
 118 }
 119
 120 can_ok( Class::B->new, qw(foo bar xxy zot) );
 121
 122 is( Class::B->new->foo, "Role::F::foo",  "... got the &foo method okay" );
 123 is( Class::B->new->zot, "Class::B::zot", "... got the &zot method okay" );
 124 is( Class::B->new->bar, "Role::D::bar",  "... got the &bar method okay" );
 125 is( Class::B->new->xxy, "Role::E::xxy",  "... got the &xxy method okay" );
 126
 127 ok(!Role::F->meta->requires_method('foo'), '... Role::F fufilled the &foo requirement');
 128
 129 {
 130     # check that a conflict can be resolved
 131     # by a role, but also new ones can be
 132     # created just as easily ...
 133
 134     package Role::D::And::E::Conflict;
 135     use Moose::Role;
 136
 137     ::is( ::exception {
 138         with qw(Role::D Role::E); # conflict between 'foo's here
 139     }, undef, "... define role Role::D::And::E::Conflict" );
 140
 141     sub foo { 'Role::D::And::E::Conflict::foo' }  # this overrides ...
 142
 143     # but these conflict
 144     sub xxy { 'Role::D::And::E::Conflict::xxy' }
 145     sub bar { 'Role::D::And::E::Conflict::bar' }
 146
 147 }
 148
 149 ok(!Role::D::And::E::Conflict->meta->requires_method('foo'), '... Role::D::And::E::Conflict fufilled the &foo requirement');
 150 ok(Role::D::And::E::Conflict->meta->requires_method('xxy'), '... Role::D::And::E::Conflict adds the &xxy requirement');
 151 ok(Role::D::And::E::Conflict->meta->requires_method('bar'), '... Role::D::And::E::Conflict adds the &bar requirement');
 152
 153 {
 154     # conflict propagation
 155
 156     package Role::H;
 157     use Moose::Role;
 158
 159     sub foo { 'Role::H::foo' }
 160     sub bar { 'Role::H::bar' }
 161
 162     package Role::J;
 163     use Moose::Role;
 164
 165     sub foo { 'Role::J::foo' }
 166     sub xxy { 'Role::J::xxy' }
 167
 168     package Role::I;
 169     use Moose::Role;
 170
 171     ::is( ::exception {
 172         with qw(Role::J Role::H); # conflict between 'foo's here
 173     }, undef, "define role Role::I" );
 174
 175     sub zot { 'Role::I::zot' }
 176     sub zzy { 'Role::I::zzy' }
 177
 178     package Class::C;
 179     use Moose;
 180
 181     ::like( ::exception {
 182         with qw(Role::I);
 183     }, qr/Due to a method name conflict in roles 'Role::H' and 'Role::J', the method 'foo' must be implemented or excluded by 'Class::C'/, "defining class Class::C fails" );
 184
 185     sub zot { 'Class::C::zot' }
 186
 187     package Class::E;
 188     use Moose;
 189
 190     ::is( ::exception {
 191         with qw(Role::I);
 192     }, undef, "resolved with method" );
 193
 194     sub foo { 'Class::E::foo' }
 195     sub zot { 'Class::E::zot' }
 196 }
 197
 198 can_ok( Class::E->new, qw(foo bar xxy zot) );
 199
 200 is( Class::E->new->foo, "Class::E::foo", "... got the right &foo method" );
 201 is( Class::E->new->zot, "Class::E::zot", "... got the right &zot method" );
 202 is( Class::E->new->bar, "Role::H::bar",  "... got the right &bar method" );
 203 is( Class::E->new->xxy, "Role::J::xxy",  "... got the right &xxy method" );
 204
 205 ok(Role::I->meta->requires_method('foo'), '... Role::I still have the &foo requirement');
 206
 207 {
 208     is( exception {
 209         package Class::D;
 210         use Moose;
 211
 212         has foo => ( default => __PACKAGE__ . "::foo", is => "rw" );
 213
 214         sub zot { 'Class::D::zot' }
 215
 216         with qw(Role::I);
 217
 218     }, undef, "resolved with attr" );
 219
 220     can_ok( Class::D->new, qw(foo bar xxy zot) );
 221     is( eval { Class::D->new->bar }, "Role::H::bar", "bar" );
 222     is( eval { Class::D->new->zzy }, "Role::I::zzy", "zzy" );
 223
 224     is( eval { Class::D->new->foo }, "Class::D::foo", "foo" );
 225     is( eval { Class::D->new->zot }, "Class::D::zot", "zot" );
 226
 227 }
 228
 229 done_testing;