Commit | Line | Data |
13eb2af6 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
0cef9fe9 |
5 | use Test::Moose; |
51c78841 |
6 | use Moose::Util qw( does_role ); |
13eb2af6 |
7 | |
8 | { |
9 | package Foo::Meta::Attribute; |
10 | use Moose::Role; |
11 | } |
12 | |
13 | { |
14 | package Foo::Meta::Attribute2; |
15 | use Moose::Role; |
16 | } |
17 | |
18 | { |
19 | package Foo::Role; |
20 | use Moose::Role; |
21 | |
22 | has foo => (is => 'ro'); |
23 | } |
24 | |
25 | { |
26 | package Foo; |
27 | use Moose; |
28 | Moose::Util::MetaRole::apply_metaroles( |
29 | for => __PACKAGE__, |
30 | class_metaroles => { attribute => ['Foo::Meta::Attribute'] }, |
31 | role_metaroles => { applied_attribute => ['Foo::Meta::Attribute2'] }, |
32 | ); |
33 | with 'Foo::Role'; |
34 | |
35 | has bar => (is => 'ro'); |
36 | } |
37 | |
38 | ok(Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute'), "attrs defined in the class get the class metarole applied"); |
39 | ok(!Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); |
40 | ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the metarole applied"); |
41 | ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the role metarole defined in the class applied"); |
42 | |
43 | { |
44 | package Bar::Meta::Attribute; |
45 | use Moose::Role; |
46 | } |
47 | |
48 | { |
49 | package Bar::Meta::Attribute2; |
50 | use Moose::Role; |
51 | } |
52 | |
53 | { |
54 | package Bar::Role; |
55 | use Moose::Role; |
56 | Moose::Util::MetaRole::apply_metaroles( |
57 | for => __PACKAGE__, |
58 | class_metaroles => { attribute => ['Bar::Meta::Attribute'] }, |
59 | role_metaroles => { applied_attribute => ['Bar::Meta::Attribute2'] }, |
60 | ); |
61 | |
62 | has foo => (is => 'ro'); |
63 | } |
64 | |
65 | { |
66 | package Bar; |
67 | use Moose; |
68 | with 'Bar::Role'; |
69 | |
70 | has bar => (is => 'ro'); |
71 | } |
72 | |
73 | ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'), "attrs defined in the class don't get the class metarole from the role applied"); |
74 | ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); |
75 | ok(Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute2'), "attrs defined in the role get the role metarole applied"); |
76 | ok(!Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied"); |
77 | |
78 | { |
79 | package Baz::Meta::Attribute; |
80 | use Moose::Role; |
81 | } |
82 | |
83 | { |
84 | package Baz::Meta::Attribute2; |
85 | use Moose::Role; |
86 | } |
87 | |
88 | { |
89 | package Baz::Role; |
90 | use Moose::Role; |
91 | Moose::Util::MetaRole::apply_metaroles( |
92 | for => __PACKAGE__, |
93 | class_metaroles => { attribute => ['Baz::Meta::Attribute'] }, |
94 | role_metaroles => { applied_attribute => ['Baz::Meta::Attribute2'] }, |
95 | ); |
96 | |
97 | has foo => (is => 'ro'); |
98 | } |
99 | |
100 | { |
101 | package Baz; |
102 | use Moose; |
103 | Moose::Util::MetaRole::apply_metaroles( |
104 | for => __PACKAGE__, |
105 | class_metaroles => { attribute => ['Baz::Meta::Attribute'] }, |
106 | role_metaroles => { applied_attribute => ['Baz::Meta::Attribute2'] }, |
107 | ); |
108 | with 'Baz::Role'; |
109 | |
110 | has bar => (is => 'ro'); |
111 | } |
112 | |
113 | ok(Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute'), "attrs defined in the class get the class metarole applied"); |
114 | ok(!Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); |
115 | ok(Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute2'), "attrs defined in the role get the role metarole applied"); |
116 | ok(!Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied"); |
117 | |
118 | { |
119 | package Accessor::Modifying::Role; |
120 | use Moose::Role; |
121 | |
122 | around _process_options => sub { |
123 | my $orig = shift; |
124 | my $self = shift; |
125 | my ($name, $params) = @_; |
126 | $self->$orig(@_); |
127 | $params->{reader} .= '_foo'; |
128 | }; |
129 | } |
130 | |
131 | { |
132 | package Plain::Role; |
133 | use Moose::Role; |
134 | |
135 | has foo => ( |
136 | is => 'ro', |
137 | isa => 'Str', |
138 | ); |
139 | } |
140 | |
141 | { |
142 | package Class::With::Trait; |
143 | use Moose; |
144 | Moose::Util::MetaRole::apply_metaroles( |
145 | for => __PACKAGE__, |
146 | class_metaroles => { |
147 | attribute => ['Accessor::Modifying::Role'], |
148 | }, |
149 | ); |
150 | with 'Plain::Role'; |
151 | |
152 | has bar => ( |
153 | is => 'ro', |
154 | isa => 'Str', |
155 | ); |
156 | } |
157 | |
158 | { |
159 | can_ok('Class::With::Trait', 'foo'); |
160 | can_ok('Class::With::Trait', 'bar_foo'); |
161 | } |
162 | |
163 | { |
164 | package Role::With::Trait; |
165 | use Moose::Role; |
166 | Moose::Util::MetaRole::apply_metaroles( |
167 | for => __PACKAGE__, |
168 | role_metaroles => { |
169 | applied_attribute => ['Accessor::Modifying::Role'], |
170 | }, |
171 | ); |
172 | with 'Plain::Role'; |
173 | |
174 | has foo => ( |
175 | is => 'ro', |
176 | isa => 'Str', |
177 | ); |
178 | |
179 | sub foo_test { |
180 | my $self = shift; |
181 | return $self->can('foo_foo'); |
182 | } |
183 | } |
184 | |
185 | { |
186 | package Class::With::Role::With::Trait; |
187 | use Moose; |
188 | with 'Role::With::Trait'; |
189 | |
190 | has bar => ( |
191 | is => 'ro', |
192 | isa => 'Str', |
193 | ); |
194 | |
195 | sub bar_test { |
196 | my $self = shift; |
197 | return $self->can('bar'); |
198 | } |
199 | } |
200 | |
201 | { |
202 | can_ok('Class::With::Role::With::Trait', 'foo_foo'); |
203 | can_ok('Class::With::Role::With::Trait', 'bar'); |
204 | } |
205 | |
0cef9fe9 |
206 | { |
207 | package Quux::Meta::Role::Attribute; |
208 | use Moose::Role; |
209 | } |
210 | |
211 | { |
212 | package Quux::Role1; |
213 | use Moose::Role; |
214 | |
215 | has foo => (traits => ['Quux::Meta::Role::Attribute'], is => 'ro'); |
51c78841 |
216 | has baz => (is => 'ro'); |
0cef9fe9 |
217 | } |
218 | |
219 | { |
220 | package Quux::Role2; |
221 | use Moose::Role; |
222 | Moose::Util::MetaRole::apply_metaroles( |
223 | for => __PACKAGE__, |
224 | role_metaroles => { |
225 | applied_attribute => ['Quux::Meta::Role::Attribute'] |
226 | }, |
227 | ); |
228 | |
229 | has bar => (is => 'ro'); |
230 | } |
231 | |
232 | { |
233 | package Quux; |
234 | use Moose; |
235 | with 'Quux::Role1', 'Quux::Role2'; |
236 | } |
237 | |
238 | { |
239 | my $foo = Quux->meta->get_attribute('foo'); |
240 | does_ok($foo, 'Quux::Meta::Role::Attribute', |
241 | "individual attribute trait applied correctly"); |
51c78841 |
242 | |
243 | my $baz = Quux->meta->get_attribute('baz'); |
244 | ok(! does_role($baz, 'Quux::Meta::Role::Attribute'), |
245 | "applied_attribute traits do not end up applying to attributes from other roles during composition"); |
0cef9fe9 |
246 | |
0cef9fe9 |
247 | my $bar = Quux->meta->get_attribute('bar'); |
248 | does_ok($bar, 'Quux::Meta::Role::Attribute', |
249 | "attribute metarole applied correctly"); |
250 | } |
251 | |
f9731c39 |
252 | { |
253 | package HasMeta; |
254 | use Moose::Role; |
255 | Moose::Util::MetaRole::apply_metaroles( |
256 | for => __PACKAGE__, |
257 | role_metaroles => { |
258 | applied_attribute => ['Quux::Meta::Role::Attribute'] |
259 | }, |
260 | ); |
261 | |
262 | has foo => (is => 'ro'); |
263 | } |
264 | |
265 | { |
266 | package NoMeta; |
267 | use Moose::Role; |
268 | |
269 | with 'HasMeta'; |
270 | |
271 | has bar => (is => 'ro'); |
272 | } |
273 | |
274 | { |
275 | package ConsumesBoth; |
276 | use Moose; |
277 | with 'HasMeta', 'NoMeta'; |
278 | } |
279 | |
280 | { |
281 | my $foo = ConsumesBoth->meta->get_attribute('foo'); |
282 | does_ok($foo, 'Quux::Meta::Role::Attribute', |
283 | 'applied_attribute traits are preserved when one role consumes another'); |
284 | |
285 | my $bar = ConsumesBoth->meta->get_attribute('bar'); |
286 | ok(! does_role($bar, 'Quux::Meta::Role::Attribute'), |
287 | "applied_attribute traits do not spill over from consumed role"); |
288 | } |
289 | |
290 | |
291 | |
13eb2af6 |
292 | done_testing; |