7 eval "use Test::Output;";
8 plan skip_all => "Test::Output is required for this test" if $@;
15 package HasConstructor;
17 sub new { bless {}, $_[0] }
19 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
21 $meta->superclasses('NotMoose');
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'
30 $meta->find_method_by_name('new')->body,
31 HasConstructor->can('new'),
32 'HasConstructor->new was untouched'
37 package My::Constructor;
39 use base 'Class::MOP::Method::Constructor';
41 sub _expected_method_class { 'Base::Class' }
45 package No::Constructor;
49 package My::Constructor2;
51 use base 'Class::MOP::Method::Constructor';
53 sub _expected_method_class { 'No::Constructor' }
59 sub new { bless {}, $_[0] }
69 return bless { not_moose => 1 }, $class;
75 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
77 $meta->superclasses('NotMoose');
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'
86 $meta->find_method_by_name('new')->body,
88 'Foo->new is inherited from NotMoose'
94 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
96 $meta->superclasses('NotMoose');
99 sub { $meta->make_immutable( replace_constructor => 1 ) },
101 'no warning when replace_constructor is true'
105 $meta->find_method_by_name('new')->package_name,
107 'Bar->new is inlined, and not inherited from NotMoose'
113 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable;
118 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
120 $meta->superclasses('Baz');
123 sub { $meta->make_immutable },
125 'no warning when inheriting from a class that has already made itself immutable'
131 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
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'
141 package My::Constructor3;
143 use base 'Class::MOP::Method::Constructor';
149 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable( constructor_class => 'My::Constructor3' );
154 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
156 $meta->superclasses('CustomCons');
159 sub { $meta->make_immutable },
161 'no warning when inheriting from a class that has already made itself immutable'
167 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
169 sub new { bless {}, shift }
171 $meta->add_before_method_modifier( 'new' => sub { } );
176 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
178 $meta->superclasses('ModdedNew');
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'
188 package My::Destructor;
190 use base 'Class::MOP::Method::Inlined';
196 my $self = bless \%options, $class;
197 $self->_inline_destructor;
202 sub _inline_destructor {
205 my ( $code, $e ) = $self->_eval_closure( {}, 'sub { }' );
208 $self->{body} = $code;
212 sub associated_metaclass { $_[0]->{metaclass} }
213 sub body { $_[0]->{body} }
214 sub _expected_method_class { 'Base::Class' }
218 package HasDestructor;
219 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
225 $meta->make_immutable(
226 inline_destructor => 1,
227 destructor_class => 'My::Destructor',
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'
235 $meta->find_method_by_name('DESTROY')->body,
236 HasDestructor->can('DESTROY'),
237 'HasDestructor->DESTROY was untouched'
242 package HasDestructor2;
243 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
247 $meta->make_immutable(
248 inline_destructor => 1,
249 destructor_class => 'My::Destructor',
250 replace_destructor => 1
255 $meta->make_immutable(
256 inline_destructor => 1,
257 destructor_class => 'My::Destructor',
258 replace_destructor => 1
262 'no warning when replace_destructor is true'
266 $meta->find_method_by_name('new')->body,
267 HasConstructor2->can('new'),
268 'HasConstructor2->new was replaced'
273 package ParentHasDestructor;
279 package DestructorChild;
281 use base 'ParentHasDestructor';
283 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
287 $meta->make_immutable(
288 inline_destructor => 1,
289 destructor_class => 'My::Destructor',
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'