t/030_roles/009_more_role_edge_cases.t

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