2 # This is automatically generated by author/import-moose-test.pl.
3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
4 use t::lib::MooseCompat;
15 # this tests that repeated role
16 # composition will not cause
17 # a conflict between two methods
18 # which are actually the same anyway
24 sub foo { "RootA::foo" }
31 sub bar { "SubAA::bar" }
37 with "SubAA", "RootA";
38 } '... role was composed as expected';
41 ok( SubAB->does("SubAA"), "does SubAA");
42 ok( SubAB->does("RootA"), "does RootA");
44 isa_ok( my $i = SubAB->new, "SubAB" );
47 is( $i->bar, "SubAA::bar", "... got thr right bar rv" );
53 } '... called foo successfully';
54 is($foo_rv, "RootA::foo", "... got the right foo rv");
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
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
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.
80 sub foo { "RootB::foo" }
94 $_[0]->counter( $_[0]->counter + 1 );
102 } '... composed the role successfully';
105 ok( SubBB->does("SubBA"), "BB does SubBA" );
106 ok( SubBB->does("RootB"), "BB does RootB" );
108 isa_ok( my $i = SubBB->new, "SubBB" );
115 } '... called foo successfully';
116 is( $foo_rv, "RootB::foo", "foo rv" );
117 is( $i->counter, 1, "after hook called" );
119 lives_ok { $i->foo } '... called foo successfully (again)';
120 is( $i->counter, 2, "after hook called (again)" );
122 ok(SubBA->meta->has_method('foo'), '... this has the foo method');
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');
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
142 sub foo { "RootC::foo" }
150 override foo => sub { "overridden" };
151 } '... cannot compose an override over a local method';
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)
161 use List::Util qw/shuffle/;
170 sub another { "abstract" }
176 sub other { "concrete a" }
182 sub method { "concrete b" }
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" );
198 package SimpleClassWithSome;
201 eval { with ::shuffle qw/ConcreteA ConcreteB/ };
202 ::ok( !$@, "simple composition without abstract" ) || ::diag $@;
204 package SimpleClassWithAll;
207 eval { with ::shuffle qw/ConcreteA ConcreteB Abstract/ };
208 ::ok( !$@, "simple composition with abstract" ) || ::diag $@;
211 foreach my $class (qw/SimpleClassWithSome SimpleClassWithAll/) {
212 foreach my $role (qw/Abstract ConcreteA ConcreteB/) {
213 ok( $class->does($role), "$class does $role");
216 foreach my $method (qw/method other another/) {
217 can_ok( $class, $method );
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" );
226 package ClassWithSome;
229 eval { with ::shuffle qw/ConcreteC ConcreteB/ };
230 ::ok( !$@, "composition without abstract" ) || ::diag $@;
232 package ClassWithAll;
235 eval { with ::shuffle qw/ConcreteC Abstract ConcreteB/ };
236 ::ok( !$@, "composition with abstract" ) || ::diag $@;
238 package ClassWithEverything;
241 eval { with ::shuffle qw/ConcreteC Abstract ConcreteA ConcreteB/ }; # this should clash
242 ::ok( !$@, "can compose ConcreteA and ConcreteC together" );
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");
250 foreach my $method (qw/method other another/) {
251 can_ok( $class, $method );
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" );