Commit | Line | Data |
46c48e08 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | |
6 | BEGIN { |
7 | eval "use Test::Output;"; |
8 | plan skip_all => "Test::Output is required for this test" if $@; |
1ca7ec40 |
9 | plan tests => 15; |
46c48e08 |
10 | } |
11 | |
12 | use Class::MOP; |
13 | |
14 | { |
15 | package HasConstructor; |
16 | |
17 | sub new { bless {}, $_[0] } |
18 | |
19 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
20 | |
21 | $meta->superclasses('NotMoose'); |
22 | |
23 | ::stderr_like( |
24 | sub { $meta->make_immutable }, |
25 | qr/\QNot inlining a constructor for HasConstructor since it defines its own constructor.\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to HasConstructor->meta->make_immutable\E/, |
26 | 'got a warning that Foo will not have an inlined constructor because it defines its own new method' |
27 | ); |
28 | |
29 | ::is( |
30 | $meta->find_method_by_name('new')->body, |
31 | HasConstructor->can('new'), |
32 | 'HasConstructor->new was untouched' |
33 | ); |
34 | } |
35 | |
36 | { |
37 | package My::Constructor; |
38 | |
39 | use base 'Class::MOP::Method::Constructor'; |
40 | |
41 | sub _expected_method_class { 'Base::Class' } |
42 | } |
43 | |
44 | { |
45 | package No::Constructor; |
46 | } |
47 | |
48 | { |
49 | package My::Constructor2; |
50 | |
51 | use base 'Class::MOP::Method::Constructor'; |
52 | |
53 | sub _expected_method_class { 'No::Constructor' } |
54 | } |
55 | |
56 | { |
57 | package Base::Class; |
58 | |
59 | sub new { bless {}, $_[0] } |
60 | sub DESTROY { } |
61 | } |
62 | |
63 | { |
64 | package NotMoose; |
65 | |
66 | sub new { |
67 | my $class = shift; |
68 | |
69 | return bless { not_moose => 1 }, $class; |
70 | } |
71 | } |
72 | |
73 | { |
74 | package Foo; |
75 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
76 | |
77 | $meta->superclasses('NotMoose'); |
78 | |
79 | ::stderr_like( |
80 | sub { $meta->make_immutable( constructor_class => 'My::Constructor' ) }, |
81 | qr/\QNot inlining 'new' for Foo since it is not inheriting the default Base::Class::new\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable/, |
82 | 'got a warning that Foo will not have an inlined constructor' |
83 | ); |
84 | |
85 | ::is( |
86 | $meta->find_method_by_name('new')->body, |
87 | NotMoose->can('new'), |
88 | 'Foo->new is inherited from NotMoose' |
89 | ); |
90 | } |
91 | |
92 | { |
93 | package Bar; |
94 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
95 | |
96 | $meta->superclasses('NotMoose'); |
97 | |
98 | ::stderr_is( |
99 | sub { $meta->make_immutable( replace_constructor => 1 ) }, |
100 | q{}, |
101 | 'no warning when replace_constructor is true' |
102 | ); |
103 | |
104 | ::is( |
105 | $meta->find_method_by_name('new')->package_name, |
106 | 'Bar', |
107 | 'Bar->new is inlined, and not inherited from NotMoose' |
108 | ); |
109 | } |
110 | |
111 | { |
112 | package Baz; |
113 | Class::MOP::Class->initialize(__PACKAGE__)->make_immutable; |
114 | } |
115 | |
116 | { |
117 | package Quux; |
118 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
119 | |
120 | $meta->superclasses('Baz'); |
121 | |
122 | ::stderr_is( |
123 | sub { $meta->make_immutable }, |
124 | q{}, |
125 | 'no warning when inheriting from a class that has already made itself immutable' |
126 | ); |
127 | } |
128 | |
129 | { |
130 | package Whatever; |
131 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
132 | |
133 | ::stderr_like( |
134 | sub { $meta->make_immutable( constructor_class => 'My::Constructor2' ) }, |
135 | qr/\QNot inlining 'new' for Whatever since No::Constructor::new is not defined/, |
136 | 'got a warning that Whatever will not have an inlined constructor because its expected inherited method does not exist' |
137 | ); |
138 | } |
139 | |
140 | { |
141 | package My::Constructor3; |
142 | |
143 | use base 'Class::MOP::Method::Constructor'; |
144 | } |
145 | |
146 | { |
147 | package CustomCons; |
148 | |
149 | Class::MOP::Class->initialize(__PACKAGE__)->make_immutable( constructor_class => 'My::Constructor3' ); |
150 | } |
151 | |
152 | { |
153 | package Subclass; |
154 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
155 | |
156 | $meta->superclasses('CustomCons'); |
157 | |
158 | ::stderr_is( |
159 | sub { $meta->make_immutable }, |
160 | q{}, |
161 | 'no warning when inheriting from a class that has already made itself immutable' |
162 | ); |
163 | } |
164 | |
165 | { |
166 | package ModdedNew; |
167 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
168 | |
169 | sub new { bless {}, shift } |
170 | |
171 | $meta->add_before_method_modifier( 'new' => sub { } ); |
172 | } |
173 | |
174 | { |
175 | package ModdedSub; |
176 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
177 | |
178 | $meta->superclasses('ModdedNew'); |
179 | |
180 | ::stderr_like( |
181 | sub { $meta->make_immutable }, |
182 | qr/\QNot inlining 'new' for ModdedSub since it has method modifiers which would be lost if it were inlined/, |
183 | 'got a warning that ModdedSub will not have an inlined constructor since it inherited a wrapped new' |
184 | ); |
185 | } |
186 | |
187 | { |
188 | package My::Destructor; |
189 | |
190 | use base 'Class::MOP::Method::Inlined'; |
191 | |
192 | sub new { |
193 | my $class = shift; |
194 | my %options = @_; |
195 | |
196 | my $self = bless \%options, $class; |
197 | $self->_inline_destructor; |
198 | |
199 | return $self; |
200 | } |
201 | |
202 | sub _inline_destructor { |
203 | my $self = shift; |
204 | |
e24b19fb |
205 | my ( $code, $e ) = $self->_eval_closure( {}, 'sub { }' ); |
206 | die $e if $e; |
46c48e08 |
207 | |
208 | $self->{body} = $code; |
209 | } |
210 | |
211 | sub is_needed { 1 } |
212 | sub associated_metaclass { $_[0]->{metaclass} } |
e24b19fb |
213 | sub body { $_[0]->{body} } |
46c48e08 |
214 | sub _expected_method_class { 'Base::Class' } |
215 | } |
216 | |
217 | { |
218 | package HasDestructor; |
219 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
220 | |
221 | sub DESTROY { } |
222 | |
223 | ::stderr_like( |
224 | sub { |
225 | $meta->make_immutable( |
226 | inline_destructor => 1, |
227 | destructor_class => 'My::Destructor', |
228 | ); |
229 | }, |
230 | qr/Not inlining a destructor for HasDestructor since it defines its own destructor./, |
231 | 'got a warning when trying to inline a destructor for a class that already defines DESTROY' |
232 | ); |
233 | |
234 | ::is( |
235 | $meta->find_method_by_name('DESTROY')->body, |
236 | HasDestructor->can('DESTROY'), |
237 | 'HasDestructor->DESTROY was untouched' |
238 | ); |
239 | } |
240 | |
241 | { |
242 | package HasDestructor2; |
243 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
244 | |
245 | sub DESTROY { } |
246 | |
247 | $meta->make_immutable( |
248 | inline_destructor => 1, |
249 | destructor_class => 'My::Destructor', |
250 | replace_destructor => 1 |
251 | ); |
252 | |
253 | ::stderr_is( |
254 | sub { |
255 | $meta->make_immutable( |
256 | inline_destructor => 1, |
257 | destructor_class => 'My::Destructor', |
258 | replace_destructor => 1 |
259 | ); |
260 | }, |
261 | q{}, |
262 | 'no warning when replace_destructor is true' |
263 | ); |
264 | |
265 | ::isnt( |
266 | $meta->find_method_by_name('new')->body, |
267 | HasConstructor2->can('new'), |
268 | 'HasConstructor2->new was replaced' |
269 | ); |
270 | } |
271 | |
272 | { |
273 | package ParentHasDestructor; |
274 | |
275 | sub DESTROY { } |
276 | } |
277 | |
278 | { |
279 | package DestructorChild; |
280 | |
281 | use base 'ParentHasDestructor'; |
282 | |
283 | my $meta = Class::MOP::Class->initialize(__PACKAGE__); |
284 | |
285 | ::stderr_like( |
286 | sub { |
287 | $meta->make_immutable( |
288 | inline_destructor => 1, |
289 | destructor_class => 'My::Destructor', |
290 | ); |
291 | }, |
292 | qr/Not inlining 'DESTROY' for DestructorChild since it is not inheriting the default Base::Class::DESTROY/, |
293 | 'got a warning when trying to inline a destructor in a class that inherits an unexpected DESTROY' |
294 | ); |
295 | } |