6 use Test::More 'no_plan';
10 my ( $role, $method ) = @_;
11 local $Test::Builder::Level = $Test::Builder::Level + 1;
14 $role->has_method($method) || $role->requires_method($method),
15 $role->name . " has or requires method $method"
18 fail("role has or requires method $method");
26 # this role eventually adds three methods, qw(foo bar xxy), but only one is
27 # known when it's still a role
29 has foo => ( is => "rw" );
31 has gorch => ( reader => "bar" );
38 # similarly this role gives attr and gorch_method
40 has attr => ( is => "rw" );
42 sub gorch_method { "gorch method" }
44 around dandy => sub { shift->(@_) . "bar" };
51 # this object will be used in an attr of Foo to test that Foo can do the
61 package Dancer::Ballerina;
70 package Dancer::Robot;
73 # this doesn't fail but it produces a requires in the role
74 # the order doesn't matter
75 has twist => ( is => "rw" );
76 ::lives_ok { with qw(Dancer) };
78 package Dancer::Something;
81 # this fail even though the method already exists
83 has twist => ( is => "rw" );
86 local our $TODO = "accessors don't satisfy role requires";
87 ::lives_ok { with qw(Dancer) };
93 # this should pass because ::Robot has the attribute to fill in the requires
94 # but due to the deferrence logic that doesn't actually work
96 local our $TODO = "attribute accessor in role doesn't satisfy role requires";
97 ::lives_ok { with qw(Dancer::Robot) };
107 handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
108 default => sub { Quxx->new },
115 default => sub { Dancer::Ballerina->new },
127 has bark => ( is => "rw" );
132 sub bark { warn "woof!" };
138 local our $TODO = "attrs and methods from a role should clash";
139 ::dies_ok { with qw(Tree Dog) }
143 # these fail because of the deferral logic winning over actual methods
144 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
145 # we've been doing for a long while, though I doubt people relied on it for
146 # anything other than fulfilling 'requires'
148 local $TODO = "attributes from role overwrite class methods";
149 is( Foo->new->foo, 42, "attr did not zap overriding method" );
150 is( Foo->new->bar, 33, "attr did not zap overriding method" );
152 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
154 # these pass, simple delegate
155 # mostly they are here to contrast the next blck
156 can_ok( Foo->new->oink, "dandy" );
157 can_ok( Foo->new->oink, "attr" );
158 can_ok( Foo->new->oink, "gorch_method" );
160 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
163 # these are broken because 'attr' is not technically part of the interface
164 can_ok( Foo->new, "gorch_method" );
166 local $TODO = "accessor methods from a role are omitted in handles role";
167 can_ok( Foo->new, "attr" );
171 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
172 ok( Foo->new->does("Gorch"), "Foo does Gorch" );
177 can_ok( Foo->new->dancer, "pirouette" );
178 can_ok( Foo->new->dancer, "twist" );
180 can_ok( Foo->new, "twist" );
181 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
184 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
185 ok( Foo->new->does("Dancer") );
191 my $gorch = Gorch->meta;
193 isa_ok( $gorch, "Moose::Meta::Role" );
195 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
198 local $TODO = "role attribute isn't a meta attribute yet";
199 isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
202 req_or_has($gorch, "gorch_method");
203 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
204 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
207 local $TODO = "role method isn't a meta object yet";
208 isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
212 local $TODO = "method modifier doesn't yet create a method requirement or meta object";
213 req_or_has($gorch, "dandy" );
215 # this specific test is maybe not backwards compat, but in theory it *does*
216 # require that method to exist
217 ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
221 local $TODO = "attribute related methods are not yet known by the role";
222 # we want this to be a part of the interface, somehow
223 req_or_has($gorch, "attr");
224 ok( $gorch->has_method("attr"), "has_method attr" );
225 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
226 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
229 my $robot = Dancer::Robot->meta;
231 isa_ok( $robot, "Moose::Meta::Role" );
233 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
236 local $TODO = "role attribute isn't a meta attribute yet";
237 isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
241 req_or_has($robot, "twist");
243 local $TODO = "attribute related methods are not yet known by the role";
244 ok( $robot->has_method("twist"), "has twist method" );
245 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
246 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
251 I think Attribute needs to be refactored in some way to better support roles.
253 There are several possible ways to do this, all of them seem plausible to me.
255 The first approach would be to change the attribute class to allow it to be
256 queried about the methods it would install.
258 Then we instantiate the attribute in the role, and instead of deferring the
259 arguments, we just make an C<unpack>ish method.
261 Then we can interrogate the attr when adding it to the role, and generate stub
262 methods for all the methods it would produce.
264 A second approach is kinda like the Immutable hack: wrap the attr in an
265 anonmyous class that disables part of its interface.
267 A third method would be to create an Attribute::Partial object that would
268 provide a more role-ish behavior, and to do this independently of the actual
271 Something similar can be done for method modifiers, but I think that's even simpler.
275 The benefits of doing this are:
277 * Much better introspection of roles
279 * More correctness in many cases (in my opinion anyway)
281 * More roles are more usable as interface declarations, without having to split
282 them into two pieces (one for the interface with a bunch of requires(), and
283 another for the actual impl with the problematic attrs (and stub methods to
284 fix the accessors) and method modifiers (dunno if this can even work at all)