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