6 use Test::More tests => 91;
9 BEGIN {use Class::MOP;use Class::MOP::Immutable;
19 __PACKAGE__->meta->add_attribute('bar' => (
30 __PACKAGE__->meta->superclasses('Foo');
32 __PACKAGE__->meta->add_attribute('baz' => (
34 default => sub { 'BAZ' },
43 __PACKAGE__->meta->superclasses('Bar');
45 __PACKAGE__->meta->add_attribute('bah' => (
57 __PACKAGE__->meta->add_attribute('bar' => (
59 predicate => 'has_bar',
60 clearer => 'clear_bar',
63 __PACKAGE__->meta->add_attribute('bah' => (
65 predicate => 'has_bah',
66 clearer => 'clear_bah',
74 is($meta->name, 'Foo', '... checking the Foo metaclass');
77 my $bar_accessor = $meta->get_method('bar');
78 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
79 isa_ok($bar_accessor, 'Class::MOP::Method');
81 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
84 ok(!$meta->is_immutable, '... our class is not immutable');
87 $meta->make_immutable(
88 inline_constructor => 1,
89 inline_accessors => 0,
91 } '... changed Foo to be immutable';
93 ok($meta->is_immutable, '... our class is now immutable');
94 isa_ok($meta, 'Class::MOP::Class');
96 # they made a constructor for us :)
102 is($foo->bar, 'BAR', '... got the right default value');
106 my $foo = Foo->new(bar => 'BAZ');
108 is($foo->bar, 'BAZ', '... got the right parameter value');
112 # check that the constructor correctly handles inheritance
114 my $bar = Bar->new();
117 is($bar->bar, 'BAR', '... got the right inherited parameter value');
118 is($bar->baz, 'BAZ', '... got the right inherited parameter value');
121 # check out accessors too
123 my $bar_accessor = $meta->get_method('bar');
124 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
125 isa_ok($bar_accessor, 'Class::MOP::Method');
127 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
132 my $meta = Bar->meta;
133 is($meta->name, 'Bar', '... checking the Bar metaclass');
136 my $bar_accessor = $meta->find_method_by_name('bar');
137 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
138 isa_ok($bar_accessor, 'Class::MOP::Method');
140 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
142 my $baz_accessor = $meta->get_method('baz');
143 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
144 isa_ok($baz_accessor, 'Class::MOP::Method');
146 ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
149 ok(!$meta->is_immutable, '... our class is not immutable');
152 $meta->make_immutable(
153 inline_constructor => 1,
154 inline_accessors => 1,
156 } '... changed Bar to be immutable';
158 ok($meta->is_immutable, '... our class is now immutable');
159 isa_ok($meta, 'Class::MOP::Class');
161 # they made a constructor for us :)
162 can_ok('Bar', 'new');
167 is($bar->bar, 'BAR', '... got the right default value');
168 is($bar->baz, 'BAZ', '... got the right default value');
172 my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
174 is($bar->bar, 'BAZ!', '... got the right parameter value');
175 is($bar->baz, 'BAR!', '... got the right parameter value');
178 # check out accessors too
180 my $bar_accessor = $meta->find_method_by_name('bar');
181 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
182 isa_ok($bar_accessor, 'Class::MOP::Method');
184 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
186 my $baz_accessor = $meta->get_method('baz');
187 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
188 isa_ok($baz_accessor, 'Class::MOP::Method');
190 ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
195 my $meta = Baz->meta;
196 is($meta->name, 'Baz', '... checking the Bar metaclass');
199 my $bar_accessor = $meta->find_method_by_name('bar');
200 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
201 isa_ok($bar_accessor, 'Class::MOP::Method');
203 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
205 my $baz_accessor = $meta->find_method_by_name('baz');
206 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
207 isa_ok($baz_accessor, 'Class::MOP::Method');
209 ok($baz_accessor->is_inline, '... the baz accessor is inlined');
211 my $bah_accessor = $meta->get_method('bah');
212 isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
213 isa_ok($bah_accessor, 'Class::MOP::Method');
215 ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
218 ok(!$meta->is_immutable, '... our class is not immutable');
221 $meta->make_immutable(
222 inline_constructor => 0,
223 inline_accessors => 1,
225 } '... changed Bar to be immutable';
227 ok($meta->is_immutable, '... our class is now immutable');
228 isa_ok($meta, 'Class::MOP::Class');
230 ok(!Baz->meta->has_method('new'), '... no constructor was made');
233 my $baz = Baz->meta->construct_instance;
235 is($baz->bar, 'BAR', '... got the right default value');
236 is($baz->baz, 'BAZ', '... got the right default value');
240 my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
242 is($baz->bar, 'BAZ!', '... got the right parameter value');
243 is($baz->baz, 'BAR!', '... got the right parameter value');
244 is($baz->bah, 'BAH!', '... got the right parameter value');
247 # check out accessors too
249 my $bar_accessor = $meta->find_method_by_name('bar');
250 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
251 isa_ok($bar_accessor, 'Class::MOP::Method');
253 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
255 my $baz_accessor = $meta->find_method_by_name('baz');
256 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
257 isa_ok($baz_accessor, 'Class::MOP::Method');
259 ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
261 my $bah_accessor = $meta->get_method('bah');
262 isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
263 isa_ok($bah_accessor, 'Class::MOP::Method');
265 ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
272 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
273 ::ok(!$buzz->has_bar, '...bar is not set');
274 ::is($buzz->bar, undef, '...bar returns undef');
275 ::ok(!$buzz->has_bar, '...bar was not autovivified');
278 ::ok($buzz->has_bar, '...bar is set');
279 ::is($buzz->bar, undef, '...bar is undef');
281 ::ok(!$buzz->has_bar, '...bar is no longerset');
284 ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
285 ::ok($buzz2->has_bar, '...bar is set');
286 ::is($buzz2->bar, undef, '...bar is undef');
292 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
293 ::ok($buzz->has_bah, '...bah is set');
294 ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
297 ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
298 ::ok($buzz2->has_bah, '...bah is set');
299 ::is($buzz2->bah, undef, '...bah is undef');