7 if(eval{ require Class::Method::Modifiers::Fast } || eval{ require Class::Method::Modifiers }){
11 plan skip_all => 'This test requires Class::Method::Modifiers(::Fast)?';
21 # this tests that repeated role
22 # composition will not cause
23 # a conflict between two methods
24 # which are actually the same anyway
30 sub foo { "RootA::foo" }
37 sub bar { "SubAA::bar" }
43 with "SubAA", "RootA";
44 } '... role was composed as expected';
47 ok( SubAB->does("SubAA"), "does SubAA");
48 ok( SubAB->does("RootA"), "does RootA");
50 isa_ok( my $i = SubAB->new, "SubAB" );
53 is( $i->bar, "SubAA::bar", "... got thr right bar rv" );
59 } '... called foo successfully';
60 is($foo_rv, "RootA::foo", "... got the right foo rv");
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
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
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.
86 sub foo { "RootB::foo" }
100 $_[0]->counter( $_[0]->counter + 1 );
108 } '... composed the role successfully';
111 ok( SubBB->does("SubBA"), "BB does SubBA" );
112 ok( SubBB->does("RootB"), "BB does RootB" );
114 isa_ok( my $i = SubBB->new, "SubBB" );
121 } '... called foo successfully';
122 is( $foo_rv, "RootB::foo", "foo rv" );
123 is( $i->counter, 1, "after hook called" );
125 lives_ok { $i->foo } '... called foo successfully (again)';
126 is( $i->counter, 2, "after hook called (again)" );
128 ok(SubBA->meta->has_method('foo'), '... this has the foo method');
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');
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
148 sub foo { "RootC::foo" }
156 override foo => sub { "overridden" };
157 } '... cannot compose an override over a local method';
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)
167 use List::Util qw/shuffle/;
176 sub another { "abstract" }
182 sub other { "concrete a" }
188 sub method { "concrete b" }
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" );
204 package SimpleClassWithSome;
207 eval { with ::shuffle qw/ConcreteA ConcreteB/ };
208 ::ok( !$@, "simple composition without abstract" ) || ::diag $@;
210 package SimpleClassWithAll;
213 eval { with ::shuffle qw/ConcreteA ConcreteB Abstract/ };
214 ::ok( !$@, "simple composition with abstract" ) || ::diag $@;
217 foreach my $class (qw/SimpleClassWithSome SimpleClassWithAll/) {
218 foreach my $role (qw/Abstract ConcreteA ConcreteB/) {
219 ok( $class->does($role), "$class does $role");
222 foreach my $method (qw/method other another/) {
223 can_ok( $class, $method );
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" );
232 package ClassWithSome;
235 eval { with ::shuffle qw/ConcreteC ConcreteB/ };
236 ::ok( !$@, "composition without abstract" ) || ::diag $@;
238 package ClassWithAll;
241 eval { with ::shuffle qw/ConcreteC Abstract ConcreteB/ };
242 ::ok( !$@, "composition with abstract" ) || ::diag $@;
244 package ClassWithEverything;
247 eval { with ::shuffle qw/ConcreteC Abstract ConcreteA ConcreteB/ }; # this should clash
248 ::ok( !$@, "can compose ConcreteA and ConcreteC together" );
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");
256 foreach my $method (qw/method other another/) {
257 can_ok( $class, $method );
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" );