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 = $self->_eval_closure( {}, 'sub { }' );
207 $self->{body} = $code;
211 sub associated_metaclass { $_[0]->{metaclass} }
212 sub _expected_method_class { 'Base::Class' }
216 package HasDestructor;
217 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
223 $meta->make_immutable(
224 inline_destructor => 1,
225 destructor_class => 'My::Destructor',
228 qr/Not inlining a destructor for HasDestructor since it defines its own destructor./,
229 'got a warning when trying to inline a destructor for a class that already defines DESTROY'
233 $meta->find_method_by_name('DESTROY')->body,
234 HasDestructor->can('DESTROY'),
235 'HasDestructor->DESTROY was untouched'
240 package HasDestructor2;
241 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
245 $meta->make_immutable(
246 inline_destructor => 1,
247 destructor_class => 'My::Destructor',
248 replace_destructor => 1
253 $meta->make_immutable(
254 inline_destructor => 1,
255 destructor_class => 'My::Destructor',
256 replace_destructor => 1
260 'no warning when replace_destructor is true'
264 $meta->find_method_by_name('new')->body,
265 HasConstructor2->can('new'),
266 'HasConstructor2->new was replaced'
271 package ParentHasDestructor;
277 package DestructorChild;
279 use base 'ParentHasDestructor';
281 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
285 $meta->make_immutable(
286 inline_destructor => 1,
287 destructor_class => 'My::Destructor',
290 qr/Not inlining 'DESTROY' for DestructorChild since it is not inheriting the default Base::Class::DESTROY/,
291 'got a warning when trying to inline a destructor in a class that inherits an unexpected DESTROY'