Commit | Line | Data |
6d6d2327 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
38bf6bf3 |
4 | use lib 't/lib'; |
6d6d2327 |
5 | use Test::More; |
be0ed157 |
6 | use Test::Fatal; |
6d6d2327 |
7 | |
8 | our $called = 0; |
9 | { |
10 | package Foo::Trait::Constructor; |
11 | use Moose::Role; |
12 | |
13 | around _generate_BUILDALL => sub { |
14 | my $orig = shift; |
15 | my $self = shift; |
16 | return $self->$orig(@_) . '$::called++;'; |
17 | } |
18 | } |
19 | |
20 | { |
21 | package Foo; |
22 | use Moose; |
23 | Moose::Util::MetaRole::apply_metaroles( |
24 | for => __PACKAGE__, |
25 | class_metaroles => { |
26 | constructor => ['Foo::Trait::Constructor'], |
27 | } |
28 | ); |
29 | } |
30 | |
31 | Foo->new; |
32 | is($called, 0, "no calls before inlining"); |
33 | Foo->meta->make_immutable; |
34 | |
35 | Foo->new; |
36 | is($called, 1, "inlined constructor has trait modifications"); |
37 | |
38 | ok(Foo->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'), |
39 | "class has correct constructor traits"); |
40 | |
41 | { |
42 | package Foo::Sub; |
43 | use Moose; |
44 | extends 'Foo'; |
45 | } |
46 | |
63eeb72b |
47 | $called = 0; |
48 | |
49 | Foo::Sub->new; |
50 | is($called, 0, "no calls before inlining"); |
51 | |
52 | Foo::Sub->meta->make_immutable; |
53 | |
6d6d2327 |
54 | Foo::Sub->new; |
63eeb72b |
55 | is($called, 1, "inherits constructor trait properly"); |
6d6d2327 |
56 | |
57 | ok(Foo::Sub->meta->constructor_class->meta->can('does_role') |
58 | && Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'), |
59 | "subclass inherits constructor traits"); |
6d6d2327 |
60 | |
f4eea413 |
61 | { |
62 | package Foo2::Role; |
63 | use Moose::Role; |
64 | } |
65 | { |
66 | package Foo2; |
67 | use Moose -traits => ['Foo2::Role']; |
f4eea413 |
68 | } |
69 | { |
70 | package Bar2; |
71 | use Moose; |
72 | } |
73 | { |
74 | package Baz2; |
75 | use Moose; |
76 | my $meta = __PACKAGE__->meta; |
be0ed157 |
77 | ::ok ! ::exception { $meta->superclasses('Foo2') }, "can set superclasses once"; |
9f83eb5d |
78 | ::isa_ok($meta, Foo2->meta->meta->name); |
be0ed157 |
79 | ::ok ! ::exception { $meta->superclasses('Bar2') }, "can still set superclasses"; |
9f83eb5d |
80 | ::isa_ok($meta, Bar2->meta->meta->name); |
81 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
82 | ['Foo2::Role'], |
83 | "still have the role attached"); |
84 | ::ok(!$meta->is_immutable, |
85 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
86 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
9f83eb5d |
87 | } |
88 | { |
89 | package Foo3::Role; |
90 | use Moose::Role; |
91 | } |
92 | { |
93 | package Bar3; |
94 | use Moose -traits => ['Foo3::Role']; |
95 | } |
96 | { |
97 | package Baz3; |
98 | use Moose -traits => ['Foo3::Role']; |
99 | my $meta = __PACKAGE__->meta; |
be0ed157 |
100 | ::ok ! ::exception { $meta->superclasses('Foo2') }, "can set superclasses once"; |
9f83eb5d |
101 | ::isa_ok($meta, Foo2->meta->meta->name); |
102 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
103 | ['Foo2::Role', 'Foo3::Role'], |
104 | "reconciled roles correctly"); |
be0ed157 |
105 | ::ok ! ::exception { $meta->superclasses('Bar3') }, "can still set superclasses"; |
9f83eb5d |
106 | ::isa_ok($meta, Bar3->meta->meta->name); |
107 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
108 | ['Foo2::Role', 'Foo3::Role'], |
109 | "roles still the same"); |
110 | ::ok(!$meta->is_immutable, |
111 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
112 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
9f83eb5d |
113 | } |
114 | { |
115 | package Quux3; |
116 | use Moose; |
117 | } |
118 | { |
119 | package Quuux3; |
120 | use Moose -traits => ['Foo3::Role']; |
121 | my $meta = __PACKAGE__->meta; |
be0ed157 |
122 | ::ok ! ::exception { $meta->superclasses('Foo2') }, "can set superclasses once"; |
9f83eb5d |
123 | ::isa_ok($meta, Foo2->meta->meta->name); |
124 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
125 | ['Foo2::Role', 'Foo3::Role'], |
126 | "reconciled roles correctly"); |
be0ed157 |
127 | ::ok ! ::exception { $meta->superclasses('Quux3') }, "can still set superclasses"; |
9f83eb5d |
128 | ::isa_ok($meta, Quux3->meta->meta->name); |
129 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
130 | ['Foo2::Role', 'Foo3::Role'], |
131 | "roles still the same"); |
132 | ::ok(!$meta->is_immutable, |
133 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
134 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
9f83eb5d |
135 | } |
136 | |
137 | { |
138 | package Foo4::Role; |
139 | use Moose::Role; |
140 | } |
141 | { |
142 | package Foo4; |
143 | use Moose -traits => ['Foo4::Role']; |
144 | __PACKAGE__->meta->make_immutable; |
145 | } |
146 | { |
147 | package Bar4; |
148 | use Moose; |
149 | } |
150 | { |
151 | package Baz4; |
152 | use Moose; |
153 | my $meta = __PACKAGE__->meta; |
be0ed157 |
154 | ::ok ! ::exception { $meta->superclasses('Foo4') }, "can set superclasses once"; |
9f83eb5d |
155 | ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); |
be0ed157 |
156 | ::ok ! ::exception { $meta->superclasses('Bar4') }, "can still set superclasses"; |
9f83eb5d |
157 | ::isa_ok($meta, Bar4->meta->meta->name); |
158 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
159 | ['Foo4::Role'], |
160 | "still have the role attached"); |
161 | ::ok(!$meta->is_immutable, |
162 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
163 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
9f83eb5d |
164 | } |
165 | { |
166 | package Foo5::Role; |
167 | use Moose::Role; |
168 | } |
169 | { |
170 | package Bar5; |
171 | use Moose -traits => ['Foo5::Role']; |
172 | } |
173 | { |
174 | package Baz5; |
175 | use Moose -traits => ['Foo5::Role']; |
176 | my $meta = __PACKAGE__->meta; |
be0ed157 |
177 | ::ok ! ::exception { $meta->superclasses('Foo4') }, "can set superclasses once"; |
9f83eb5d |
178 | ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); |
179 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
180 | ['Foo4::Role', 'Foo5::Role'], |
181 | "reconciled roles correctly"); |
be0ed157 |
182 | ::ok ! ::exception { $meta->superclasses('Bar5') }, "can still set superclasses"; |
9f83eb5d |
183 | ::isa_ok($meta, Bar5->meta->meta->name); |
184 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
185 | ['Foo4::Role', 'Foo5::Role'], |
186 | "roles still the same"); |
187 | ::ok(!$meta->is_immutable, |
188 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
189 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
9f83eb5d |
190 | } |
191 | { |
192 | package Quux5; |
193 | use Moose; |
194 | } |
195 | { |
196 | package Quuux5; |
197 | use Moose -traits => ['Foo5::Role']; |
198 | my $meta = __PACKAGE__->meta; |
be0ed157 |
199 | ::ok ! ::exception { $meta->superclasses('Foo4') }, "can set superclasses once"; |
9f83eb5d |
200 | ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); |
201 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
202 | ['Foo4::Role', 'Foo5::Role'], |
203 | "reconciled roles correctly"); |
be0ed157 |
204 | ::ok ! ::exception { $meta->superclasses('Quux5') }, "can still set superclasses"; |
9f83eb5d |
205 | ::isa_ok($meta, Quux5->meta->meta->name); |
206 | ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], |
207 | ['Foo4::Role', 'Foo5::Role'], |
208 | "roles still the same"); |
209 | ::ok(!$meta->is_immutable, |
210 | "immutable superclass doesn't make this class immutable"); |
be0ed157 |
211 | ::ok ! ::exception { $meta->make_immutable }, "can still make immutable"; |
f4eea413 |
212 | } |
213 | |
76176929 |
214 | { |
215 | package Foo5::Meta::Role; |
216 | use Moose::Role; |
217 | } |
218 | { |
219 | package Foo5::SuperClass::WithMetaRole; |
220 | use Moose -traits =>'Foo5::Meta::Role'; |
221 | } |
222 | { |
223 | package Foo5::SuperClass::After::Attribute; |
224 | use Moose; |
225 | } |
226 | { |
227 | package Foo5; |
228 | use Moose; |
229 | my @superclasses = ('Foo5::SuperClass::WithMetaRole'); |
230 | extends @superclasses; |
231 | |
232 | has an_attribute_generating_methods => ( is => 'ro' ); |
233 | |
234 | push(@superclasses, 'Foo5::SuperClass::After::Attribute'); |
235 | |
be0ed157 |
236 | ::ok ! ::exception { |
76176929 |
237 | extends @superclasses; |
be0ed157 |
238 | }, 'MI extends after_generated_methods with metaclass roles'; |
239 | ::ok ! ::exception { |
76176929 |
240 | extends reverse @superclasses; |
be0ed157 |
241 | }, |
76176929 |
242 | 'MI extends after_generated_methods with metaclass roles (reverse)'; |
243 | } |
244 | |
590e8894 |
245 | { |
246 | package Foo6::Meta::Role; |
247 | use Moose::Role; |
248 | } |
249 | { |
250 | package Foo6::SuperClass::WithMetaRole; |
251 | use Moose -traits =>'Foo6::Meta::Role'; |
252 | } |
253 | { |
254 | package Foo6::Meta::OtherRole; |
255 | use Moose::Role; |
256 | } |
257 | { |
258 | package Foo6::SuperClass::After::Attribute; |
259 | use Moose -traits =>'Foo6::Meta::OtherRole'; |
260 | } |
261 | { |
262 | package Foo6; |
263 | use Moose; |
264 | my @superclasses = ('Foo6::SuperClass::WithMetaRole'); |
265 | extends @superclasses; |
266 | |
267 | has an_attribute_generating_methods => ( is => 'ro' ); |
268 | |
269 | push(@superclasses, 'Foo6::SuperClass::After::Attribute'); |
270 | |
be0ed157 |
271 | ::like ::exception { |
590e8894 |
272 | extends @superclasses; |
be0ed157 |
273 | }, qr/compat.*pristine/, |
590e8894 |
274 | 'unsafe MI extends after_generated_methods with metaclass roles'; |
be0ed157 |
275 | ::like ::exception { |
590e8894 |
276 | extends reverse @superclasses; |
be0ed157 |
277 | }, qr/compat.*pristine/, |
590e8894 |
278 | 'unsafe MI extends after_generated_methods with metaclass roles (reverse)'; |
279 | } |
280 | |
38bf6bf3 |
281 | { |
282 | package Foo7::Meta::Trait; |
283 | use Moose::Role; |
284 | } |
285 | |
286 | { |
287 | package Foo7; |
288 | use Moose -traits => ['Foo7::Meta::Trait']; |
289 | } |
290 | |
291 | { |
292 | package Bar7; |
293 | # in an external file |
294 | use Moose -traits => ['Bar7::Meta::Trait']; |
be0ed157 |
295 | ::ok ! ::exception { extends 'Foo7' }, "role reconciliation works"; |
38bf6bf3 |
296 | } |
297 | |
298 | { |
299 | package Bar72; |
300 | # in an external file |
301 | use Moose -traits => ['Bar7::Meta::Trait2']; |
be0ed157 |
302 | ::ok ! ::exception { extends 'Foo7' }, "role reconciliation works"; |
38bf6bf3 |
303 | } |
304 | |
6d6d2327 |
305 | done_testing; |