7 eval "use Test::Output;";
8 plan skip_all => "Test::Output is required for this test" if $@;
14 package HasConstructor;
16 sub new { bless {}, $_[0] }
18 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
20 $meta->superclasses('NotMoose');
23 sub { $meta->make_immutable },
24 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/,
25 'got a warning that Foo will not have an inlined constructor because it defines its own new method'
29 $meta->find_method_by_name('new')->body,
30 HasConstructor->can('new'),
31 'HasConstructor->new was untouched'
36 package My::Constructor;
38 use base 'Class::MOP::Method::Constructor';
40 sub _expected_method_class { 'Base::Class' }
44 package No::Constructor;
48 package My::Constructor2;
50 use base 'Class::MOP::Method::Constructor';
52 sub _expected_method_class { 'No::Constructor' }
58 sub new { bless {}, $_[0] }
68 return bless { not_moose => 1 }, $class;
74 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
76 $meta->superclasses('NotMoose');
79 sub { $meta->make_immutable( constructor_class => 'My::Constructor' ) },
80 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/,
81 'got a warning that Foo will not have an inlined constructor'
85 $meta->find_method_by_name('new')->body,
87 'Foo->new is inherited from NotMoose'
93 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
95 $meta->superclasses('NotMoose');
98 sub { $meta->make_immutable( replace_constructor => 1 ) },
100 'no warning when replace_constructor is true'
104 $meta->find_method_by_name('new')->package_name,
106 'Bar->new is inlined, and not inherited from NotMoose'
112 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable;
117 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
119 $meta->superclasses('Baz');
122 sub { $meta->make_immutable },
124 'no warning when inheriting from a class that has already made itself immutable'
130 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
133 sub { $meta->make_immutable( constructor_class => 'My::Constructor2' ) },
134 qr/\QNot inlining 'new' for Whatever since No::Constructor::new is not defined/,
135 'got a warning that Whatever will not have an inlined constructor because its expected inherited method does not exist'
140 package My::Constructor3;
142 use base 'Class::MOP::Method::Constructor';
148 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable( constructor_class => 'My::Constructor3' );
153 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
155 $meta->superclasses('CustomCons');
158 sub { $meta->make_immutable },
160 'no warning when inheriting from a class that has already made itself immutable'
166 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
168 sub new { bless {}, shift }
170 $meta->add_before_method_modifier( 'new' => sub { } );
175 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
177 $meta->superclasses('ModdedNew');
180 sub { $meta->make_immutable },
181 qr/\QNot inlining 'new' for ModdedSub since it has method modifiers which would be lost if it were inlined/,
182 'got a warning that ModdedSub will not have an inlined constructor since it inherited a wrapped new'
187 package My::Destructor;
189 use base 'Class::MOP::Method::Inlined';
195 my $self = bless \%options, $class;
196 $self->_inline_destructor;
201 sub _inline_destructor {
204 my ( $code, $e ) = $self->_eval_closure( {}, 'sub { }' );
207 $self->{body} = $code;
211 sub associated_metaclass { $_[0]->{metaclass} }
212 sub body { $_[0]->{body} }
213 sub _expected_method_class { 'Base::Class' }
217 package HasDestructor;
218 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
224 $meta->make_immutable(
225 inline_destructor => 1,
226 destructor_class => 'My::Destructor',
229 qr/Not inlining a destructor for HasDestructor since it defines its own destructor./,
230 'got a warning when trying to inline a destructor for a class that already defines DESTROY'
234 $meta->find_method_by_name('DESTROY')->body,
235 HasDestructor->can('DESTROY'),
236 'HasDestructor->DESTROY was untouched'
241 package HasDestructor2;
242 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
246 $meta->make_immutable(
247 inline_destructor => 1,
248 destructor_class => 'My::Destructor',
249 replace_destructor => 1
254 $meta->make_immutable(
255 inline_destructor => 1,
256 destructor_class => 'My::Destructor',
257 replace_destructor => 1
261 'no warning when replace_destructor is true'
265 $meta->find_method_by_name('new')->body,
266 HasConstructor2->can('new'),
267 'HasConstructor2->new was replaced'
272 package ParentHasDestructor;
278 package DestructorChild;
280 use base 'ParentHasDestructor';
282 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
286 $meta->make_immutable(
287 inline_destructor => 1,
288 destructor_class => 'My::Destructor',
291 qr/Not inlining 'DESTROY' for DestructorChild since it is not inheriting the default Base::Class::DESTROY/,
292 'got a warning when trying to inline a destructor in a class that inherits an unexpected DESTROY'