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 ::ok ! ::exception { with qw(Dancer) };
78 package Dancer::Something;
81 # this fail even though the method already exists
83 has twist => ( is => "rw" );
86 ::ok ! ::exception { with qw(Dancer) };
92 # this should pass because ::Robot has the attribute to fill in the requires
93 # but due to the deferrence logic that doesn't actually work
95 local our $TODO = "attribute accessor in role doesn't satisfy role requires";
96 ::ok ! ::exception { with qw(Dancer::Robot) };
106 handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation?
107 default => sub { Quxx->new },
114 default => sub { Dancer::Ballerina->new },
126 has bark => ( is => "rw" );
131 sub bark { warn "woof!" };
137 local our $TODO = "attrs and methods from a role should clash";
138 ::ok ::exception { with qw(Tree Dog) },
142 # these fail because of the deferral logic winning over actual methods
143 # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack
144 # we've been doing for a long while, though I doubt people relied on it for
145 # anything other than fulfilling 'requires'
147 local $TODO = "attributes from role overwrite class methods";
148 is( Foo->new->foo, 42, "attr did not zap overriding method" );
149 is( Foo->new->bar, 33, "attr did not zap overriding method" );
151 is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh
153 # these pass, simple delegate
154 # mostly they are here to contrast the next blck
155 can_ok( Foo->new->oink, "dandy" );
156 can_ok( Foo->new->oink, "attr" );
157 can_ok( Foo->new->oink, "gorch_method" );
159 ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" );
162 # these are broken because 'attr' is not technically part of the interface
163 can_ok( Foo->new, "gorch_method" );
165 local $TODO = "accessor methods from a role are omitted in handles role";
166 can_ok( Foo->new, "attr" );
170 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
171 ok( Foo->new->does("Gorch"), "Foo does Gorch" );
176 can_ok( Foo->new->dancer, "pirouette" );
177 can_ok( Foo->new->dancer, "twist" );
179 can_ok( Foo->new, "twist" );
180 ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" );
183 local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class";
184 ok( Foo->new->does("Dancer") );
190 my $gorch = Gorch->meta;
192 isa_ok( $gorch, "Moose::Meta::Role" );
194 ok( $gorch->has_attribute("attr"), "has attribute 'attr'" );
195 isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Role::Attribute" );
197 req_or_has($gorch, "gorch_method");
198 ok( $gorch->has_method("gorch_method"), "has_method gorch_method" );
199 ok( !$gorch->requires_method("gorch_method"), "requires gorch method" );
200 isa_ok( $gorch->get_method("gorch_method"), "Moose::Meta::Method" );
203 local $TODO = "method modifier doesn't yet create a method requirement or meta object";
204 req_or_has($gorch, "dandy" );
206 # this specific test is maybe not backwards compat, but in theory it *does*
207 # require that method to exist
208 ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" );
212 local $TODO = "attribute related methods are not yet known by the role";
213 # we want this to be a part of the interface, somehow
214 req_or_has($gorch, "attr");
215 ok( $gorch->has_method("attr"), "has_method attr" );
216 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method" );
217 isa_ok( $gorch->get_method("attr"), "Moose::Meta::Method::Accessor" );
220 my $robot = Dancer::Robot->meta;
222 isa_ok( $robot, "Moose::Meta::Role" );
224 ok( $robot->has_attribute("twist"), "has attr 'twist'" );
225 isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Role::Attribute" );
228 req_or_has($robot, "twist");
230 local $TODO = "attribute related methods are not yet known by the role";
231 ok( $robot->has_method("twist"), "has twist method" );
232 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method" );
233 isa_ok( $robot->get_method("twist"), "Moose::Meta::Method::Accessor" );
240 I think Attribute needs to be refactored in some way to better support roles.
242 There are several possible ways to do this, all of them seem plausible to me.
244 The first approach would be to change the attribute class to allow it to be
245 queried about the methods it would install.
247 Then we instantiate the attribute in the role, and instead of deferring the
248 arguments, we just make an C<unpack>ish method.
250 Then we can interrogate the attr when adding it to the role, and generate stub
251 methods for all the methods it would produce.
253 A second approach is kinda like the Immutable hack: wrap the attr in an
254 anonmyous class that disables part of its interface.
256 A third method would be to create an Attribute::Partial object that would
257 provide a more role-ish behavior, and to do this independently of the actual
260 Something similar can be done for method modifiers, but I think that's even simpler.
264 The benefits of doing this are:
266 * Much better introspection of roles
268 * More correctness in many cases (in my opinion anyway)
270 * More roles are more usable as interface declarations, without having to split
271 them into two pieces (one for the interface with a bunch of requires(), and
272 another for the actual impl with the problematic attrs (and stub methods to
273 fix the accessors) and method modifiers (dunno if this can even work at all)