t/roles/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     # that the consumer's method shadows just like for classes.
  52
  53     package Role::A::Shadow;
  54     use Moose::Role;
  55
  56     with 'Role::A';
  57
  58     sub bar { 'Role::A::Shadow::bar' }
  59
  60     package Class::A::Shadow;
  61     use Moose;
  62
  63     ::is( ::exception {
  64         with 'Role::A::Shadow';
  65     }, undef, '... did fufill the requirement of &bar method' );
  66 }
  67
  68 can_ok( Class::A::Shadow->new, qw(bar) );
  69
  70 is( Class::A::Shadow->new->bar, 'Role::A::Shadow::bar', "... got the right bar method" );
  71
  72 {
  73     # check that when two roles are composed, they conflict
  74     # but the composing role can resolve that conflict
  75
  76     package Role::D;
  77     use Moose::Role;
  78
  79     sub foo { 'Role::D::foo' }
  80     sub bar { 'Role::D::bar' }
  81
  82     package Role::E;
  83     use Moose::Role;
  84
  85     sub foo { 'Role::E::foo' }
  86     sub xxy { 'Role::E::xxy' }
  87
  88     package Role::F;
  89     use Moose::Role;
  90
  91     ::is( ::exception {
  92         with qw(Role::D Role::E); # conflict between 'foo's here
  93     }, undef, "define role Role::F" );
  94
  95     sub foo { 'Role::F::foo' }
  96     sub zot { 'Role::F::zot' }
  97
  98     package Class::B;
  99     use Moose;
 100
 101     ::is( ::exception {
 102         with qw(Role::F);
 103     }, undef, "define class Class::B" );
 104
 105     sub zot { 'Class::B::zot' }
 106 }
 107
 108 can_ok( Class::B->new, qw(foo bar xxy zot) );
 109
 110 is( Class::B->new->foo, "Role::F::foo",  "... got the &foo method okay" );
 111 is( Class::B->new->zot, "Class::B::zot", "... got the &zot method okay" );
 112 is( Class::B->new->bar, "Role::D::bar",  "... got the &bar method okay" );
 113 is( Class::B->new->xxy, "Role::E::xxy",  "... got the &xxy method okay" );
 114
 115 ok(!Role::F->meta->requires_method('foo'), '... Role::F fufilled the &foo requirement');
 116
 117 {
 118     # check that a conflict can be resolved
 119     # by a role, but also new ones can be
 120     # created just as easily ...
 121
 122     package Role::D::And::E::NoConflict;
 123     use Moose::Role;
 124
 125     ::is( ::exception {
 126         with qw(Role::D Role::E); # conflict between 'foo's here
 127     }, undef, "... define role Role::D::And::E::NoConflict" );
 128
 129     sub foo { 'Role::D::And::E::NoConflict::foo' }  # this overrides ...
 130
 131     sub xxy { 'Role::D::And::E::NoConflict::xxy' }  # and so do these ...
 132     sub bar { 'Role::D::And::E::NoConflict::bar' }
 133
 134 }
 135
 136 ok(!Role::D::And::E::NoConflict->meta->requires_method('foo'), '... Role::D::And::E::NoConflict fufilled the &foo requirement');
 137 ok(!Role::D::And::E::NoConflict->meta->requires_method('xxy'), '... Role::D::And::E::NoConflict fulfilled the &xxy requirement');
 138 ok(!Role::D::And::E::NoConflict->meta->requires_method('bar'), '... Role::D::And::E::NoConflict fulfilled the &bar requirement');
 139
 140 {
 141     # conflict propagation
 142
 143     package Role::H;
 144     use Moose::Role;
 145
 146     sub foo { 'Role::H::foo' }
 147     sub bar { 'Role::H::bar' }
 148
 149     package Role::J;
 150     use Moose::Role;
 151
 152     sub foo { 'Role::J::foo' }
 153     sub xxy { 'Role::J::xxy' }
 154
 155     package Role::I;
 156     use Moose::Role;
 157
 158     ::is( ::exception {
 159         with qw(Role::J Role::H); # conflict between 'foo's here
 160     }, undef, "define role Role::I" );
 161
 162     sub zot { 'Role::I::zot' }
 163     sub zzy { 'Role::I::zzy' }
 164
 165     package Class::C;
 166     use Moose;
 167
 168     ::like( ::exception {
 169         with qw(Role::I);
 170     }, 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" );
 171
 172     sub zot { 'Class::C::zot' }
 173
 174     package Class::E;
 175     use Moose;
 176
 177     ::is( ::exception {
 178         with qw(Role::I);
 179     }, undef, "resolved with method" );
 180
 181     sub foo { 'Class::E::foo' }
 182     sub zot { 'Class::E::zot' }
 183 }
 184
 185 can_ok( Class::E->new, qw(foo bar xxy zot) );
 186
 187 is( Class::E->new->foo, "Class::E::foo", "... got the right &foo method" );
 188 is( Class::E->new->zot, "Class::E::zot", "... got the right &zot method" );
 189 is( Class::E->new->bar, "Role::H::bar",  "... got the right &bar method" );
 190 is( Class::E->new->xxy, "Role::J::xxy",  "... got the right &xxy method" );
 191
 192 ok(Role::I->meta->requires_method('foo'), '... Role::I still have the &foo requirement');
 193
 194 {
 195     is( exception {
 196         package Class::D;
 197         use Moose;
 198
 199         has foo => ( default => __PACKAGE__ . "::foo", is => "rw" );
 200
 201         sub zot { 'Class::D::zot' }
 202
 203         with qw(Role::I);
 204
 205     }, undef, "resolved with attr" );
 206
 207     can_ok( Class::D->new, qw(foo bar xxy zot) );
 208     is( eval { Class::D->new->bar }, "Role::H::bar", "bar" );
 209     is( eval { Class::D->new->zzy }, "Role::I::zzy", "zzy" );
 210
 211     is( eval { Class::D->new->foo }, "Class::D::foo", "foo" );
 212     is( eval { Class::D->new->zot }, "Class::D::zot", "zot" );
 213
 214 }
 215
 216 done_testing;