t/030_roles/007_roles_and_required_method_edge_cases.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7 use Test::Exception;
   8
   9 =pod
  10
  11 NOTE:
  12 A fair amount of these tests will likely be irrelevant
  13 once we have more fine grained control over the class
  14 building process. A lot of the edge cases tested here
  15 are actually related to class construction order and
  16 not any real functionality.
  17 - SL
  18
  19 =cut
  20
  21 BEGIN {
  22     use_ok('Moose');
  23     use_ok('Moose::Role');
  24 }
  25
  26 =pod
  27
  28 Role which requires a method implemented
  29 in another role as an override (it does
  30 not remove the requirement)
  31
  32 =cut
  33
  34 {
  35     package Role::RequireFoo;
  36     use strict;
  37     use warnings;
  38     use Moose::Role;
  39
  40     requires 'foo';
  41
  42     package Role::ProvideFoo;
  43     use strict;
  44     use warnings;
  45     use Moose::Role;
  46
  47     ::lives_ok {
  48         with 'Role::RequireFoo';
  49     } '... the required "foo" method will not exist yet (but we will live)';
  50
  51     override 'foo' => sub { 'Role::ProvideFoo::foo' };
  52 }
  53
  54 is_deeply(
  55     [ Role::ProvideFoo->meta->get_required_method_list ],
  56     [ 'foo' ],
  57     '... foo method is still required for Role::ProvideFoo');
  58
  59 =pod
  60
  61 Role which requires a method implemented
  62 in the consuming class as an override.
  63 It will fail since method modifiers are
  64 second class citizens.
  65
  66 =cut
  67
  68 {
  69     package Class::ProvideFoo::Base;
  70     use Moose;
  71
  72     sub foo { 'Class::ProvideFoo::Base::foo' }
  73
  74     package Class::ProvideFoo::Override1;
  75     use Moose;
  76
  77     extends 'Class::ProvideFoo::Base';
  78
  79     ::lives_ok {
  80         with 'Role::RequireFoo';
  81     } '... the required "foo" method will be found in the superclass';
  82
  83     override 'foo' => sub { 'Class::ProvideFoo::foo' };
  84
  85     package Class::ProvideFoo::Override2;
  86     use Moose;
  87
  88     extends 'Class::ProvideFoo::Base';
  89
  90     override 'foo' => sub { 'Class::ProvideFoo::foo' };
  91
  92     ::dies_ok {
  93         with 'Role::RequireFoo';
  94     } '... the required "foo" method exists, but it is an override (and we will die)';
  95
  96 }
  97
  98 =pod
  99
 100 Now same thing, but with a before
 101 method modifier.
 102
 103 =cut
 104
 105 {
 106     package Class::ProvideFoo::Before1;
 107     use Moose;
 108
 109     extends 'Class::ProvideFoo::Base';
 110
 111     ::lives_ok {
 112         with 'Role::RequireFoo';
 113     } '... the required "foo" method will be found in the superclass';
 114
 115     before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
 116
 117     package Class::ProvideFoo::Before2;
 118     use Moose;
 119
 120     extends 'Class::ProvideFoo::Base';
 121
 122     before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
 123
 124     ::dies_ok {
 125         with 'Role::RequireFoo';
 126     } '... the required "foo" method exists, but it is a before (and we will die)';
 127
 128     package Class::ProvideFoo::Before3;
 129     use Moose;
 130
 131     extends 'Class::ProvideFoo::Base';
 132
 133     ::lives_ok {
 134         with 'Role::RequireFoo';
 135     } '... the required "foo" method will not exist yet (and we will die)';
 136
 137     sub foo { 'Class::ProvideFoo::foo' }
 138     before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
 139
 140     package Class::ProvideFoo::Before4;
 141     use Moose;
 142
 143     extends 'Class::ProvideFoo::Base';
 144
 145     sub foo { 'Class::ProvideFoo::foo' }
 146     before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
 147
 148     ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
 149     ::is(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__,
 150     '... but the original method is from our package');
 151
 152     ::lives_ok {
 153         with 'Role::RequireFoo';
 154     } '... the required "foo" method exists in the symbol table (and we will live)';
 155
 156     package Class::ProvideFoo::Before5;
 157     use Moose;
 158
 159     extends 'Class::ProvideFoo::Base';
 160
 161     before 'foo' => sub { 'Class::ProvideFoo::foo:before' };
 162
 163     ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped');
 164     ::isnt(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__,
 165     '... but the original method is not from our package');
 166
 167     ::dies_ok {
 168         with 'Role::RequireFoo';
 169     } '... the required "foo" method exists, but it is a before wrapping the super (and we will die)';
 170 }
 171
 172 =pod
 173
 174 Now same thing, but with a method from an attribute
 175 method modifier.
 176
 177 =cut
 178
 179 {
 180
 181     package Class::ProvideFoo::Attr1;
 182     use Moose;
 183
 184     extends 'Class::ProvideFoo::Base';
 185
 186     ::lives_ok {
 187         with 'Role::RequireFoo';
 188     } '... the required "foo" method will be found in the superclass (but then overriden)';
 189
 190     has 'foo' => (is => 'ro');
 191
 192     package Class::ProvideFoo::Attr2;
 193     use Moose;
 194
 195     extends 'Class::ProvideFoo::Base';
 196
 197     has 'foo' => (is => 'ro');
 198
 199     ::dies_ok {
 200         with 'Role::RequireFoo';
 201     } '... the required "foo" method exists, but it is a before (and we will die)';
 202 }
 203
 204 # ...
 205 # a method required in a role, but then
 206 # implemented in the superclass (as an
 207 # attribute accessor too)
 208
 209 {
 210     package Foo::Class::Base;
 211     use Moose;
 212
 213     has 'bar' =>  (
 214         isa     => 'Int',
 215         is      => 'rw',
 216         default => sub { 1 }
 217     );
 218 }
 219 {
 220     package Foo::Role;
 221     use Moose::Role;
 222
 223     requires 'bar';
 224
 225     has 'foo' => (
 226         isa     => 'Int',
 227         is      => 'rw',
 228         lazy    => 1,
 229         default => sub { (shift)->bar + 1 }
 230     );
 231 }
 232 {
 233     package Foo::Class::Child;
 234     use Moose;
 235     extends 'Foo::Class::Base';
 236
 237     ::dies_ok {
 238         with 'Foo::Role';
 239     } '... our role combined successfully';
 240 }
 241
 242
 243