5 use Test::More tests => 74;
12 # this tests that repeated role
13 # composition will not cause
14 # a conflict between two methods
15 # which are actually the same anyway
21 sub foo { "RootA::foo" }
28 sub bar { "SubAA::bar" }
34 with "SubAA", "RootA";
35 } '... role was composed as expected';
38 ok( SubAB->does("SubAA"), "does SubAA");
39 ok( SubAB->does("RootA"), "does RootA");
41 isa_ok( my $i = SubAB->new, "SubAB" );
44 is( $i->bar, "SubAA::bar", "... got thr right bar rv" );
50 } '... called foo successfully';
51 is($foo_rv, "RootA::foo", "... got the right foo rv");
56 # this edge cases shows the application of
57 # an after modifier over a method which
58 # was added during role composotion.
59 # The way this will work is as follows:
60 # role SubBA will consume RootB and
61 # get a local copy of RootB::foo, it
62 # will also store a deferred after modifier
63 # to be applied to whatever class SubBA is
65 # When class SubBB comsumed role SubBA, the
66 # RootB::foo method is added to SubBB, then
67 # the deferred after modifier from SubBA is
69 # It is important to note that the application
70 # of the after modifier does not happen until
71 # role SubBA is composed into SubAA.
77 sub foo { "RootB::foo" }
91 $_[0]->counter( $_[0]->counter + 1 );
99 } '... composed the role successfully';
102 ok( SubBB->does("SubBA"), "BB does SubBA" );
103 ok( SubBB->does("RootB"), "BB does RootB" );
105 isa_ok( my $i = SubBB->new, "SubBB" );
112 } '... called foo successfully';
113 is( $foo_rv, "RootB::foo", "foo rv" );
114 is( $i->counter, 1, "after hook called" );
116 lives_ok { $i->foo } '... called foo successfully (again)';
117 is( $i->counter, 2, "after hook called (again)" );
119 ok(SubBA->meta->has_method('foo'), '... this has the foo method');
122 # $subba_foo_rv = SubBA::foo();
123 #} '... called the sub as a function correctly';
124 #is($subba_foo_rv, 'RootB::foo', '... the SubBA->foo is still the RootB version');
129 # this checks that an override method
130 # does not try to trample over a locally
131 # composed in method. In this case the
132 # RootC::foo, which is composed into
133 # SubCA cannot be trampled with an
139 sub foo { "RootC::foo" }
147 override foo => sub { "overridden" };
148 } '... cannot compose an override over a local method';
153 # need to talk to Yuval about the motivation behind
154 # this test, I am not sure we are testing anything
155 # useful here (although more tests cant hurt)
158 use List::Util qw/shuffle/;
167 sub another { "abstract" }
173 sub other { "concrete a" }
179 sub method { "concrete b" }
186 # this was originally override, but
187 # that wont work (see above set of tests)
188 # so I switched it to around.
189 # However, this may not be testing the
190 # same thing that was originally intended
191 around other => sub {
192 return ( (shift)->() . " + c" );
195 package SimpleClassWithSome;
198 eval { with ::shuffle qw/ConcreteA ConcreteB/ };
199 ::ok( !$@, "simple composition without abstract" ) || ::diag $@;
201 package SimpleClassWithAll;
204 eval { with ::shuffle qw/ConcreteA ConcreteB Abstract/ };
205 ::ok( !$@, "simple composition with abstract" ) || ::diag $@;
208 foreach my $class (qw/SimpleClassWithSome SimpleClassWithAll/) {
209 foreach my $role (qw/Abstract ConcreteA ConcreteB/) {
210 ok( $class->does($role), "$class does $role");
213 foreach my $method (qw/method other another/) {
214 can_ok( $class, $method );
217 is( eval { $class->another }, "abstract", "provided by abstract" );
218 is( eval { $class->other }, "concrete a", "provided by concrete a" );
219 is( eval { $class->method }, "concrete b", "provided by concrete b" );
223 package ClassWithSome;
226 eval { with ::shuffle qw/ConcreteC ConcreteB/ };
227 ::ok( !$@, "composition without abstract" ) || ::diag $@;
229 package ClassWithAll;
232 eval { with ::shuffle qw/ConcreteC Abstract ConcreteB/ };
233 ::ok( !$@, "composition with abstract" ) || ::diag $@;
235 package ClassWithEverything;
238 eval { with ::shuffle qw/ConcreteC Abstract ConcreteA ConcreteB/ }; # this should clash
239 ::ok( !$@, "can compose ConcreteA and ConcreteC together" );
242 foreach my $class (qw/ClassWithSome ClassWithAll ClassWithEverything/) {
243 foreach my $role (qw/Abstract ConcreteA ConcreteB ConcreteC/) {
244 ok( $class->does($role), "$class does $role");
247 foreach my $method (qw/method other another/) {
248 can_ok( $class, $method );
251 is( eval { $class->another }, "abstract", "provided by abstract" );
252 is( eval { $class->other }, "concrete a + c", "provided by concrete c + a" );
253 is( eval { $class->method }, "concrete b", "provided by concrete b" );