Commit | Line | Data |
c47cf415 |
1 | #!/usr/bin/perl |
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; |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use Test::More; |
10 | $TODO = q{Mouse is not yet completed}; |
11 | use Test::Exception; |
12 | |
13 | sub req_or_has ($$) { |
14 | my ( $role, $method ) = @_; |
15 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
16 | if ( $role ) { |
17 | ok( |
18 | $role->has_method($method) || $role->requires_method($method), |
19 | $role->name . " has or requires method $method" |
20 | ); |
21 | } else { |
22 | fail("role has or requires method $method"); |
23 | } |
24 | } |
25 | |
26 | { |
27 | package Bar; |
28 | use Mouse::Role; |
29 | |
30 | # this role eventually adds three methods, qw(foo bar xxy), but only one is |
31 | # known when it's still a role |
32 | |
33 | has foo => ( is => "rw" ); |
34 | |
35 | has gorch => ( reader => "bar" ); |
36 | |
37 | sub xxy { "BAAAD" } |
38 | |
39 | package Gorch; |
40 | use Mouse::Role; |
41 | |
42 | # similarly this role gives attr and gorch_method |
43 | |
44 | has attr => ( is => "rw" ); |
45 | |
46 | sub gorch_method { "gorch method" } |
47 | |
48 | around dandy => sub { shift->(@_) . "bar" }; |
49 | |
50 | package Quxx; |
51 | use Mouse; |
52 | |
53 | sub dandy { "foo" } |
54 | |
55 | # this object will be used in an attr of Foo to test that Foo can do the |
56 | # Gorch interface |
57 | |
58 | with qw(Gorch); |
59 | |
60 | package Dancer; |
61 | use Mouse::Role; |
62 | |
63 | requires "twist"; |
64 | |
65 | package Dancer::Ballerina; |
66 | use Mouse; |
67 | |
68 | with qw(Dancer); |
69 | |
70 | sub twist { } |
71 | |
72 | sub pirouette { } |
73 | |
74 | package Dancer::Robot; |
75 | use Mouse::Role; |
76 | |
77 | # this doesn't fail but it produces a requires in the role |
78 | # the order doesn't matter |
79 | has twist => ( is => "rw" ); |
80 | ::lives_ok { with qw(Dancer) }; |
81 | |
82 | package Dancer::Something; |
83 | use Mouse; |
84 | |
85 | # this fail even though the method already exists |
86 | |
87 | has twist => ( is => "rw" ); |
88 | |
89 | { |
90 | ::lives_ok { with qw(Dancer) }; |
91 | } |
92 | |
93 | package Dancer::80s; |
94 | use Mouse; |
95 | |
96 | # this should pass because ::Robot has the attribute to fill in the requires |
97 | # but due to the deferrence logic that doesn't actually work |
98 | { |
99 | local our $TODO = "attribute accessor in role doesn't satisfy role requires"; |
100 | ::lives_ok { with qw(Dancer::Robot) }; |
101 | } |
102 | |
103 | package Foo; |
104 | use Mouse; |
105 | |
106 | with qw(Bar); |
107 | |
108 | has oink => ( |
109 | is => "rw", |
110 | handles => "Gorch", # should handles take the same arguments as 'with'? Meta::Role::Application::Delegation? |
111 | default => sub { Quxx->new }, |
112 | ); |
113 | |
114 | has dancer => ( |
115 | is => "rw", |
116 | does => "Dancer", |
117 | handles => "Dancer", |
118 | default => sub { Dancer::Ballerina->new }, |
119 | ); |
120 | |
121 | sub foo { 42 } |
122 | |
123 | sub bar { 33 } |
124 | |
125 | sub xxy { 7 } |
126 | |
127 | package Tree; |
128 | use Mouse::Role; |
129 | |
130 | has bark => ( is => "rw" ); |
131 | |
132 | package Dog; |
133 | use Mouse::Role; |
134 | |
135 | sub bark { warn "woof!" }; |
136 | |
137 | package EntPuppy; |
138 | use Mouse; |
139 | |
140 | { |
141 | local our $TODO = "attrs and methods from a role should clash"; |
142 | ::dies_ok { with qw(Tree Dog) } |
143 | } |
144 | } |
145 | |
146 | # these fail because of the deferral logic winning over actual methods |
147 | # this might be tricky to fix due to the 'sub foo {}; has foo => ( )' hack |
148 | # we've been doing for a long while, though I doubt people relied on it for |
149 | # anything other than fulfilling 'requires' |
150 | { |
151 | local $TODO = "attributes from role overwrite class methods"; |
152 | is( Foo->new->foo, 42, "attr did not zap overriding method" ); |
153 | is( Foo->new->bar, 33, "attr did not zap overriding method" ); |
154 | } |
155 | is( Foo->new->xxy, 7, "method did not zap overriding method" ); # duh |
156 | |
157 | # these pass, simple delegate |
158 | # mostly they are here to contrast the next blck |
159 | can_ok( Foo->new->oink, "dandy" ); |
160 | can_ok( Foo->new->oink, "attr" ); |
161 | can_ok( Foo->new->oink, "gorch_method" ); |
162 | |
163 | ok( Foo->new->oink->does("Gorch"), "Quxx does Gorch" ); |
164 | |
165 | |
166 | # these are broken because 'attr' is not technically part of the interface |
167 | can_ok( Foo->new, "gorch_method" ); |
168 | { |
169 | local $TODO = "accessor methods from a role are omitted in handles role"; |
170 | can_ok( Foo->new, "attr" ); |
171 | } |
172 | |
173 | { |
174 | local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class"; |
175 | ok( Foo->new->does("Gorch"), "Foo does Gorch" ); |
176 | } |
177 | |
178 | |
179 | # these work |
180 | can_ok( Foo->new->dancer, "pirouette" ); |
181 | can_ok( Foo->new->dancer, "twist" ); |
182 | |
183 | can_ok( Foo->new, "twist" ); |
184 | ok( !Foo->new->can("pirouette"), "can't pirouette, not part of the iface" ); |
185 | |
186 | { |
187 | local $TODO = "handles role doesn't add the role to the ->does of the delegate's parent class"; |
188 | ok( Foo->new->does("Dancer") ); |
189 | } |
190 | |
191 | |
192 | |
193 | |
194 | my $gorch = Gorch->meta; |
195 | |
196 | isa_ok( $gorch, "Mouse::Meta::Role" ); |
197 | |
198 | ok( $gorch->has_attribute("attr"), "has attribute 'attr'" ); |
199 | isa_ok( $gorch->get_attribute("attr"), "Mouse::Meta::Role::Attribute" ); |
200 | |
201 | req_or_has($gorch, "gorch_method"); |
202 | ok( $gorch->has_method("gorch_method"), "has_method gorch_method" ); |
203 | ok( !$gorch->requires_method("gorch_method"), "requires gorch method" ); |
204 | isa_ok( $gorch->get_method("gorch_method"), "Mouse::Meta::Method" ); |
205 | |
206 | { |
207 | local $TODO = "method modifier doesn't yet create a method requirement or meta object"; |
208 | req_or_has($gorch, "dandy" ); |
209 | |
210 | # this specific test is maybe not backwards compat, but in theory it *does* |
211 | # require that method to exist |
212 | ok( $gorch->requires_method("dandy"), "requires the dandy method for the modifier" ); |
213 | } |
214 | |
215 | { |
216 | local $TODO = "attribute related methods are not yet known by the role"; |
217 | # we want this to be a part of the interface, somehow |
218 | req_or_has($gorch, "attr"); |
219 | ok( $gorch->has_method("attr"), "has_method attr" ); |
220 | isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" ); |
221 | isa_ok( $gorch->get_method("attr"), "Mouse::Meta::Method" ); |
222 | } |
223 | |
224 | my $robot = Dancer::Robot->meta; |
225 | |
226 | isa_ok( $robot, "Mouse::Meta::Role" ); |
227 | |
228 | ok( $robot->has_attribute("twist"), "has attr 'twist'" ); |
229 | isa_ok( $robot->get_attribute("twist"), "Mouse::Meta::Role::Attribute" ); |
230 | |
231 | { |
232 | req_or_has($robot, "twist"); |
233 | |
234 | local $TODO = "attribute related methods are not yet known by the role"; |
235 | ok( $robot->has_method("twist"), "has twist method" ); |
236 | isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" ); |
237 | isa_ok( $robot->get_method("twist"), "Mouse::Meta::Method" ); |
238 | } |
239 | |
240 | done_testing; |
241 | |
242 | __END__ |
243 | |
244 | I think Attribute needs to be refactored in some way to better support roles. |
245 | |
246 | There are several possible ways to do this, all of them seem plausible to me. |
247 | |
248 | The first approach would be to change the attribute class to allow it to be |
249 | queried about the methods it would install. |
250 | |
251 | Then we instantiate the attribute in the role, and instead of deferring the |
252 | arguments, we just make an C<unpack>ish method. |
253 | |
254 | Then we can interrogate the attr when adding it to the role, and generate stub |
255 | methods for all the methods it would produce. |
256 | |
257 | A second approach is kinda like the Immutable hack: wrap the attr in an |
258 | anonmyous class that disables part of its interface. |
259 | |
260 | A third method would be to create an Attribute::Partial object that would |
261 | provide a more role-ish behavior, and to do this independently of the actual |
262 | Attribute class. |
263 | |
264 | Something similar can be done for method modifiers, but I think that's even simpler. |
265 | |
266 | |
267 | |
268 | The benefits of doing this are: |
269 | |
270 | * Much better introspection of roles |
271 | |
272 | * More correctness in many cases (in my opinion anyway) |
273 | |
274 | * More roles are more usable as interface declarations, without having to split |
275 | them into two pieces (one for the interface with a bunch of requires(), and |
276 | another for the actual impl with the problematic attrs (and stub methods to |
277 | fix the accessors) and method modifiers (dunno if this can even work at all) |
278 | |
279 | |