7 'Test::Output' => '0.01', # skip all if not installed
13 package HasConstructor;
15 sub new { bless {}, $_[0] }
17 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
19 $meta->superclasses('NotMoose');
22 sub { $meta->make_immutable },
23 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/,
24 'got a warning that Foo will not have an inlined constructor because it defines its own new method'
28 $meta->find_method_by_name('new')->body,
29 HasConstructor->can('new'),
30 'HasConstructor->new was untouched'
35 package My::Constructor;
37 use base 'Class::MOP::Method::Constructor';
39 sub _expected_method_class { 'Base::Class' }
43 package No::Constructor;
47 package My::Constructor2;
49 use base 'Class::MOP::Method::Constructor';
51 sub _expected_method_class { 'No::Constructor' }
57 sub new { bless {}, $_[0] }
67 return bless { not_moose => 1 }, $class;
73 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
75 $meta->superclasses('NotMoose');
78 sub { $meta->make_immutable( constructor_class => 'My::Constructor' ) },
79 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/,
80 'got a warning that Foo will not have an inlined constructor'
84 $meta->find_method_by_name('new')->body,
86 'Foo->new is inherited from NotMoose'
92 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
94 $meta->superclasses('NotMoose');
97 sub { $meta->make_immutable( replace_constructor => 1 ) },
99 'no warning when replace_constructor is true'
103 $meta->find_method_by_name('new')->package_name,
105 'Bar->new is inlined, and not inherited from NotMoose'
111 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable;
116 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
118 $meta->superclasses('Baz');
121 sub { $meta->make_immutable },
123 'no warning when inheriting from a class that has already made itself immutable'
129 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
132 sub { $meta->make_immutable( constructor_class => 'My::Constructor2' ) },
133 qr/\QNot inlining 'new' for Whatever since No::Constructor::new is not defined/,
134 'got a warning that Whatever will not have an inlined constructor because its expected inherited method does not exist'
139 package My::Constructor3;
141 use base 'Class::MOP::Method::Constructor';
147 Class::MOP::Class->initialize(__PACKAGE__)->make_immutable( constructor_class => 'My::Constructor3' );
152 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
154 $meta->superclasses('CustomCons');
157 sub { $meta->make_immutable },
159 'no warning when inheriting from a class that has already made itself immutable'
165 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
167 sub new { bless {}, shift }
169 $meta->add_before_method_modifier( 'new' => sub { } );
174 my $meta = Class::MOP::Class->initialize(__PACKAGE__);
176 $meta->superclasses('ModdedNew');
179 sub { $meta->make_immutable },
180 qr/\QNot inlining 'new' for ModdedSub since it has method modifiers which would be lost if it were inlined/,
181 'got a warning that ModdedSub will not have an inlined constructor since it inherited a wrapped new'
186 package My::Destructor;
188 use base 'Class::MOP::Method::Inlined';
194 my $self = bless \%options, $class;
195 $self->_inline_destructor;
200 sub _inline_destructor {
203 my ( $code, $e ) = $self->_eval_closure( {}, 'sub { }' );
206 $self->{body} = $code;
210 sub associated_metaclass { $_[0]->{metaclass} }
211 sub body { $_[0]->{body} }
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'