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