6 use Test::More 'no_plan';
10 my ( $role, $method ) = @_;
11 local $Test::Builder::Level = $Test::Builder::Level + 1;
13 ok( $role->has_method($method) || $role->requires_method($method), $role->name . " has or requires method $method" );
15 fail("role has or requires method $method");
23 # this role eventually adds three methods, qw(foo bar xxy), but only one is
24 # known when it's still a role
26 has foo => ( is => "rw" );
28 has gorch => ( reader => "bar" );
35 # similarly this role gives attr and gorch_method
37 has attr => ( is => "rw" );
39 sub gorch_method { "gorch method" }
41 around dandy => sub { shift->(@_) . "bar" };
48 # this object will be used in an attr of Foo to test that Foo can do the
58 package Dancer::Ballerina;
67 package Dancer::Robot;
70 # this doesn't fail but it produces a requires in the role
71 # the order doesn't matter
72 has twist => ( is => "rw" );
73 ::lives_ok { with qw(Dancer) };
75 package Dancer::Something;
78 # this fail even though the method already exists
80 has twist => ( is => "rw" );
83 local our $TODO = "accessors don't satisfy role requires";
84 ::lives_ok { with qw(Dancer) };
90 # this should pass because ::Robot has the attribute to fill in the requires
91 # but due to the deferrence logic that doesn't actually work
93 local our $TODO = "attribute accessor in role doesn't satisfy role requires";
94 ::lives_ok { with qw(Dancer::Robot) };
104 handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
105 default => sub { Quxx->new },
112 default => sub { Dancer::Ballerina->new },
122 # these fail because of the deferral logic winning over actual methods
123 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
124 # we've been doing for a long while, though I doubt people relied on it for
125 # anything other than fulfilling 'requires'
127 local $TODO = "attributes from role overwrite class methods";
128 is( Foo->new->foo, 42, "attr did not zap overriding method" );
129 is( Foo->new->bar, 33, "attr did not zap overriding method" );
131 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
133 # these pass, simple delegate
134 # mostly they are here to contrast the next blck
135 can_ok( Foo->new->oink, "dandy" );
136 can_ok( Foo->new->oink, "attr" );
137 can_ok( Foo->new->oink, "gorch_method" );
139 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
142 # these are broken because 'attr' is not technically part of the interface
143 can_ok( Foo->new, "gorch_method" );
145 local $TODO = "accessor methods from a role are omitted in handles role";
146 can_ok( Foo->new, "attr" );
150 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
151 ok( Foo->new->does("Gorch"), "Foo does Gorch" );
156 can_ok( Foo->new->dancer, "pirouette" );
157 can_ok( Foo->new->dancer, "twist" );
159 can_ok( Foo->new, "twist" );
160 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
163 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
164 ok( Foo->new->does("Dancer") );
170 my $gorch = Gorch->meta;
172 isa_ok( $gorch, "Moose::Meta::Role" );
174 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
177 local $TODO = "role attribute isn't a meta attribute yet";
178 isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" );
181 req_or_has($gorch, "gorch_method");
182 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
183 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
186 local $TODO = "role method isn't a meta object yet";
187 isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
191 local $TODO = "method modifier doesn't yet create a method requirement or meta object";
192 req_or_has($gorch, "dandy" );
194 # this specific test is maybe not backwards compat, but in theory it *does*
195 # require that method to exist
196 ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
200 local $TODO = "attribute related methods are not yet known by the role";
201 # we want this to be a part of the interface, somehow
202 req_or_has($gorch, "attr");
203 ok( $gorch->has_method("attr"), "has_method attr" );
204 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
205 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
208 my $robot = Dancer::Robot->meta;
210 isa_ok( $robot, "Moose::Meta::Role" );
212 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
215 local $TODO = "role attribute isn't a meta attribute yet";
216 isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" );
220 local $TODO = "attribute related methods are not yet known by the role";
221 req_or_has($robot, "twist");
222 ok( $robot->has_method("twist"), "has twist method" );
223 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
224 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
229 I think Attribute needs to be refactored in some way to better support roles.
231 There are several possible ways to do this, all of them seem plausible to me.
233 The first approach would be to change the attribute class to allow it to be
234 queried about the methods it would install.
236 Then we instantiate the attribute in the role, and instead of deferring the
237 arguments, we just make an C<unpack>ish method.
239 Then we can interrogate the attr when adding it to the role, and generate stub
240 methods for all the methods it would produce.
242 A second approach is kinda like the Immutable hack: wrap the attr in an
243 anonmyous class that disables part of its interface.
245 A third method would be to create an Attribute::Partial object that would
246 provide a more role-ish behavior, and to do this independently of the actual
249 Something similar can be done for method modifiers, but I think that's even simpler.
253 The benefits of doing this are:
255 * Much better introspection of roles
257 * More correctness in many cases (in my opinion anyway)
259 * More roles are more usable as interface declarations, without having to split
260 them into two pieces (one for the interface with a bunch of requires(), and
261 another for the actual impl with the problematic attrs (and stub methods to
262 fix the accessors) and method modifiers (dunno if this can even work at all)