6 use Test::More tests => 93;
11 use_ok('Class::MOP::Immutable');
21 __PACKAGE__->meta->add_attribute('bar' => (
32 __PACKAGE__->meta->superclasses('Foo');
34 __PACKAGE__->meta->add_attribute('baz' => (
36 default => sub { 'BAZ' },
45 __PACKAGE__->meta->superclasses('Bar');
47 __PACKAGE__->meta->add_attribute('bah' => (
59 __PACKAGE__->meta->add_attribute('bar' => (
61 predicate => 'has_bar',
62 clearer => 'clear_bar',
65 __PACKAGE__->meta->add_attribute('bah' => (
67 predicate => 'has_bah',
68 clearer => 'clear_bah',
76 is($meta->name, 'Foo', '... checking the Foo metaclass');
79 my $bar_accessor = $meta->get_method('bar');
80 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
81 isa_ok($bar_accessor, 'Class::MOP::Method');
83 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
86 ok(!$meta->is_immutable, '... our class is not immutable');
89 $meta->make_immutable(
90 inline_constructor => 1,
91 inline_accessors => 0,
93 } '... changed Foo to be immutable';
95 ok($meta->is_immutable, '... our class is now immutable');
96 isa_ok($meta, 'Class::MOP::Class');
98 # they made a constructor for us :)
104 is($foo->bar, 'BAR', '... got the right default value');
108 my $foo = Foo->new(bar => 'BAZ');
110 is($foo->bar, 'BAZ', '... got the right parameter value');
114 # check that the constructor correctly handles inheritance
116 my $bar = Bar->new();
119 is($bar->bar, 'BAR', '... got the right inherited parameter value');
120 is($bar->baz, 'BAZ', '... got the right inherited parameter value');
123 # check out accessors too
125 my $bar_accessor = $meta->get_method('bar');
126 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
127 isa_ok($bar_accessor, 'Class::MOP::Method');
129 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
134 my $meta = Bar->meta;
135 is($meta->name, 'Bar', '... checking the Bar metaclass');
138 my $bar_accessor = $meta->find_method_by_name('bar');
139 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
140 isa_ok($bar_accessor, 'Class::MOP::Method');
142 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
144 my $baz_accessor = $meta->get_method('baz');
145 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
146 isa_ok($baz_accessor, 'Class::MOP::Method');
148 ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
151 ok(!$meta->is_immutable, '... our class is not immutable');
154 $meta->make_immutable(
155 inline_constructor => 1,
156 inline_accessors => 1,
158 } '... changed Bar to be immutable';
160 ok($meta->is_immutable, '... our class is now immutable');
161 isa_ok($meta, 'Class::MOP::Class');
163 # they made a constructor for us :)
164 can_ok('Bar', 'new');
169 is($bar->bar, 'BAR', '... got the right default value');
170 is($bar->baz, 'BAZ', '... got the right default value');
174 my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
176 is($bar->bar, 'BAZ!', '... got the right parameter value');
177 is($bar->baz, 'BAR!', '... got the right parameter value');
180 # check out accessors too
182 my $bar_accessor = $meta->find_method_by_name('bar');
183 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
184 isa_ok($bar_accessor, 'Class::MOP::Method');
186 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
188 my $baz_accessor = $meta->get_method('baz');
189 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
190 isa_ok($baz_accessor, 'Class::MOP::Method');
192 ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
197 my $meta = Baz->meta;
198 is($meta->name, 'Baz', '... checking the Bar metaclass');
201 my $bar_accessor = $meta->find_method_by_name('bar');
202 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
203 isa_ok($bar_accessor, 'Class::MOP::Method');
205 ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
207 my $baz_accessor = $meta->find_method_by_name('baz');
208 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
209 isa_ok($baz_accessor, 'Class::MOP::Method');
211 ok($baz_accessor->is_inline, '... the baz accessor is inlined');
213 my $bah_accessor = $meta->get_method('bah');
214 isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
215 isa_ok($bah_accessor, 'Class::MOP::Method');
217 ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
220 ok(!$meta->is_immutable, '... our class is not immutable');
223 $meta->make_immutable(
224 inline_constructor => 0,
225 inline_accessors => 1,
227 } '... changed Bar to be immutable';
229 ok($meta->is_immutable, '... our class is now immutable');
230 isa_ok($meta, 'Class::MOP::Class');
232 ok(!Baz->meta->has_method('new'), '... no constructor was made');
235 my $baz = Baz->meta->construct_instance;
237 is($baz->bar, 'BAR', '... got the right default value');
238 is($baz->baz, 'BAZ', '... got the right default value');
242 my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
244 is($baz->bar, 'BAZ!', '... got the right parameter value');
245 is($baz->baz, 'BAR!', '... got the right parameter value');
246 is($baz->bah, 'BAH!', '... got the right parameter value');
249 # check out accessors too
251 my $bar_accessor = $meta->find_method_by_name('bar');
252 isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
253 isa_ok($bar_accessor, 'Class::MOP::Method');
255 ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
257 my $baz_accessor = $meta->find_method_by_name('baz');
258 isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
259 isa_ok($baz_accessor, 'Class::MOP::Method');
261 ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
263 my $bah_accessor = $meta->get_method('bah');
264 isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
265 isa_ok($bah_accessor, 'Class::MOP::Method');
267 ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
274 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
275 ::ok(!$buzz->has_bar, '...bar is not set');
276 ::is($buzz->bar, undef, '...bar returns undef');
277 ::ok(!$buzz->has_bar, '...bar was not autovivified');
280 ::ok($buzz->has_bar, '...bar is set');
281 ::is($buzz->bar, undef, '...bar is undef');
283 ::ok(!$buzz->has_bar, '...bar is no longerset');
286 ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
287 ::ok($buzz2->has_bar, '...bar is set');
288 ::is($buzz2->bar, undef, '...bar is undef');
294 ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
295 ::ok($buzz->has_bah, '...bah is set');
296 ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
299 ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
300 ::ok($buzz2->has_bah, '...bah is set');
301 ::is($buzz2->bah, undef, '...bah is undef');