t/030_roles/009_more_role_edge_cases.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 BEGIN{
   7     if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifier }){
   8         plan tests => 74;
   9     }
  10     else{
  11         plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
  12     }
  13 }
  14
  15 use Test::Exception;
  16
  17
  18
  19 {
  20     # NOTE:
  21     # this tests that repeated role
  22     # composition will not cause
  23     # a conflict between two methods
  24     # which are actually the same anyway
  25
  26     {
  27         package RootA;
  28         use Mouse::Role;
  29
  30         sub foo { "RootA::foo" }
  31
  32         package SubAA;
  33         use Mouse::Role;
  34
  35         with "RootA";
  36
  37         sub bar { "SubAA::bar" }
  38
  39         package SubAB;
  40         use Mouse;
  41
  42         ::lives_ok {
  43             with "SubAA", "RootA";
  44         } '... role was composed as expected';
  45     }
  46
  47     ok( SubAB->does("SubAA"), "does SubAA");
  48     ok( SubAB->does("RootA"), "does RootA");
  49
  50     isa_ok( my $i = SubAB->new, "SubAB" );
  51
  52     can_ok( $i, "bar" );
  53     is( $i->bar, "SubAA::bar", "... got thr right bar rv" );
  54
  55     can_ok( $i, "foo" );
  56     my $foo_rv;
  57     lives_ok {
  58         $foo_rv = $i->foo;
  59     } '... called foo successfully';
  60     is($foo_rv, "RootA::foo", "... got the right foo rv");
  61 }
  62
  63 {
  64     # NOTE:
  65     # this edge cases shows the application of
  66     # an after modifier over a method which
  67     # was added during role composotion.
  68     # The way this will work is as follows:
  69     #    role SubBA will consume RootB and
  70     #    get a local copy of RootB::foo, it
  71     #    will also store a deferred after modifier
  72     #    to be applied to whatever class SubBA is
  73     #    composed into.
  74     #    When class SubBB comsumed role SubBA, the
  75     #    RootB::foo method is added to SubBB, then
  76     #    the deferred after modifier from SubBA is
  77     #    applied to it.
  78     # It is important to note that the application
  79     # of the after modifier does not happen until
  80     # role SubBA is composed into SubAA.
  81
  82     {
  83         package RootB;
  84         use Mouse::Role;
  85
  86         sub foo { "RootB::foo" }
  87
  88         package SubBA;
  89         use Mouse::Role;
  90
  91         with "RootB";
  92
  93         has counter => (
  94             isa => "Num",
  95             is  => "rw",
  96             default => 0,
  97         );
  98
  99         after foo => sub {
 100             $_[0]->counter( $_[0]->counter + 1 );
 101         };
 102
 103         package SubBB;
 104         use Mouse;
 105
 106         ::lives_ok {
 107             with "SubBA";
 108         } '... composed the role successfully';
 109     }
 110
 111     ok( SubBB->does("SubBA"), "BB does SubBA" );
 112     ok( SubBB->does("RootB"), "BB does RootB" );
 113
 114     isa_ok( my $i = SubBB->new, "SubBB" );
 115
 116     can_ok( $i, "foo" );
 117
 118     my $foo_rv;
 119     lives_ok {
 120         $foo_rv = $i->foo
 121     } '... called foo successfully';
 122     is( $foo_rv, "RootB::foo", "foo rv" );
 123     is( $i->counter, 1, "after hook called" );
 124
 125     lives_ok { $i->foo } '... called foo successfully (again)';
 126     is( $i->counter, 2, "after hook called (again)" );
 127
 128     ok(SubBA->meta->has_method('foo'), '... this has the foo method');
 129     #my $subba_foo_rv;
 130     #lives_ok {
 131     #    $subba_foo_rv = SubBA::foo();
 132     #} '... called the sub as a function correctly';
 133     #is($subba_foo_rv, 'RootB::foo', '... the SubBA->foo is still the RootB version');
 134 }
 135
 136 {
 137     # NOTE:
 138     # this checks that an override method
 139     # does not try to trample over a locally
 140     # composed in method. In this case the
 141     # RootC::foo, which is composed into
 142     # SubCA cannot be trampled with an
 143     # override of 'foo'
 144     {
 145         package RootC;
 146         use Mouse::Role;
 147
 148         sub foo { "RootC::foo" }
 149
 150         package SubCA;
 151         use Mouse::Role;
 152
 153         with "RootC";
 154
 155         ::dies_ok {
 156             override foo => sub { "overridden" };
 157         } '... cannot compose an override over a local method';
 158     }
 159 }
 160
 161 # NOTE:
 162 # need to talk to Yuval about the motivation behind
 163 # this test, I am not sure we are testing anything
 164 # useful here (although more tests cant hurt)
 165
 166 {
 167     use List::Util qw/shuffle/;
 168
 169     {
 170         package Abstract;
 171         use Mouse::Role;
 172
 173         requires "method";
 174         requires "other";
 175
 176         sub another { "abstract" }
 177
 178         package ConcreteA;
 179         use Mouse::Role;
 180         with "Abstract";
 181
 182         sub other { "concrete a" }
 183
 184         package ConcreteB;
 185         use Mouse::Role;
 186         with "Abstract";
 187
 188         sub method { "concrete b" }
 189
 190         package ConcreteC;
 191         use Mouse::Role;
 192         with "ConcreteA";
 193
 194         # NOTE:
 195         # this was originally override, but
 196         # that wont work (see above set of tests)
 197         # so I switched it to around.
 198         # However, this may not be testing the
 199         # same thing that was originally intended
 200         around other => sub {
 201             return ( (shift)->() . " + c" );
 202         };
 203
 204         package SimpleClassWithSome;
 205         use Mouse;
 206
 207         eval { with ::shuffle qw/ConcreteA ConcreteB/ };
 208         ::ok( !$@, "simple composition without abstract" ) || ::diag $@;
 209
 210         package SimpleClassWithAll;
 211         use Mouse;
 212
 213         eval { with ::shuffle qw/ConcreteA ConcreteB Abstract/ };
 214         ::ok( !$@, "simple composition with abstract" ) || ::diag $@;
 215     }
 216
 217     foreach my $class (qw/SimpleClassWithSome SimpleClassWithAll/) {
 218         foreach my $role (qw/Abstract ConcreteA ConcreteB/) {
 219             ok( $class->does($role), "$class does $role");
 220         }
 221
 222         foreach my $method (qw/method other another/) {
 223             can_ok( $class, $method );
 224         }
 225
 226         is( eval { $class->another }, "abstract", "provided by abstract" );
 227         is( eval { $class->other }, "concrete a", "provided by concrete a" );
 228         is( eval { $class->method }, "concrete b", "provided by concrete b" );
 229     }
 230
 231     {
 232         package ClassWithSome;
 233         use Mouse;
 234
 235         eval { with ::shuffle qw/ConcreteC ConcreteB/ };
 236         ::ok( !$@, "composition without abstract" ) || ::diag $@;
 237
 238         package ClassWithAll;
 239         use Mouse;
 240
 241         eval { with ::shuffle qw/ConcreteC Abstract ConcreteB/ };
 242         ::ok( !$@, "composition with abstract" ) || ::diag $@;
 243
 244         package ClassWithEverything;
 245         use Mouse;
 246
 247         eval { with ::shuffle qw/ConcreteC Abstract ConcreteA ConcreteB/ }; # this should clash
 248         ::ok( !$@, "can compose ConcreteA and ConcreteC together" );
 249     }
 250
 251     foreach my $class (qw/ClassWithSome ClassWithAll ClassWithEverything/) {
 252         foreach my $role (qw/Abstract ConcreteA ConcreteB ConcreteC/) {
 253             ok( $class->does($role), "$class does $role");
 254         }
 255
 256         foreach my $method (qw/method other another/) {
 257             can_ok( $class, $method );
 258         }
 259
 260         is( eval { $class->another }, "abstract", "provided by abstract" );
 261         is( eval { $class->other }, "concrete a + c", "provided by concrete c + a" );
 262         is( eval { $class->method }, "concrete b", "provided by concrete b" );
 263     }
 264 }