Commit | Line | Data |
d90b42a6 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8768ecf3 |
6 | use Test::More tests => 93; |
d90b42a6 |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
8768ecf3 |
11 | use_ok('Class::MOP::Immutable'); |
d90b42a6 |
12 | } |
13 | |
14 | { |
15 | package Foo; |
8768ecf3 |
16 | |
d90b42a6 |
17 | use strict; |
18 | use warnings; |
19 | use metaclass; |
8768ecf3 |
20 | |
d90b42a6 |
21 | __PACKAGE__->meta->add_attribute('bar' => ( |
22 | reader => 'bar', |
23 | default => 'BAR', |
24 | )); |
8768ecf3 |
25 | |
d90b42a6 |
26 | package Bar; |
8768ecf3 |
27 | |
d90b42a6 |
28 | use strict; |
29 | use warnings; |
30 | use metaclass; |
8768ecf3 |
31 | |
d90b42a6 |
32 | __PACKAGE__->meta->superclasses('Foo'); |
33 | |
34 | __PACKAGE__->meta->add_attribute('baz' => ( |
35 | reader => 'baz', |
36 | default => sub { 'BAZ' }, |
8768ecf3 |
37 | )); |
38 | |
d90b42a6 |
39 | package Baz; |
8768ecf3 |
40 | |
d90b42a6 |
41 | use strict; |
42 | use warnings; |
43 | use metaclass; |
8768ecf3 |
44 | |
d90b42a6 |
45 | __PACKAGE__->meta->superclasses('Bar'); |
46 | |
47 | __PACKAGE__->meta->add_attribute('bah' => ( |
48 | reader => 'bah', |
49 | default => 'BAH', |
8768ecf3 |
50 | )); |
51 | |
52 | package Buzz; |
53 | |
54 | use strict; |
55 | use warnings; |
56 | use metaclass; |
57 | |
58 | |
59 | __PACKAGE__->meta->add_attribute('bar' => ( |
60 | accessor => 'bar', |
61 | predicate => 'has_bar', |
62 | clearer => 'clear_bar', |
63 | )); |
64 | |
65 | __PACKAGE__->meta->add_attribute('bah' => ( |
66 | accessor => 'bah', |
67 | predicate => 'has_bah', |
68 | clearer => 'clear_bah', |
69 | default => 'BAH' |
70 | )); |
71 | |
d90b42a6 |
72 | } |
73 | |
74 | { |
75 | my $meta = Foo->meta; |
76 | is($meta->name, 'Foo', '... checking the Foo metaclass'); |
8768ecf3 |
77 | |
d90b42a6 |
78 | { |
79 | my $bar_accessor = $meta->get_method('bar'); |
80 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
81 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
82 | |
83 | ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); |
d90b42a6 |
84 | } |
8768ecf3 |
85 | |
86 | ok(!$meta->is_immutable, '... our class is not immutable'); |
d90b42a6 |
87 | |
88 | lives_ok { |
89 | $meta->make_immutable( |
90 | inline_constructor => 1, |
8768ecf3 |
91 | inline_accessors => 0, |
d90b42a6 |
92 | ); |
93 | } '... changed Foo to be immutable'; |
94 | |
8768ecf3 |
95 | ok($meta->is_immutable, '... our class is now immutable'); |
96 | isa_ok($meta, 'Class::MOP::Class'); |
97 | |
d90b42a6 |
98 | # they made a constructor for us :) |
99 | can_ok('Foo', 'new'); |
8768ecf3 |
100 | |
d90b42a6 |
101 | { |
102 | my $foo = Foo->new; |
103 | isa_ok($foo, 'Foo'); |
104 | is($foo->bar, 'BAR', '... got the right default value'); |
105 | } |
8768ecf3 |
106 | |
d90b42a6 |
107 | { |
108 | my $foo = Foo->new(bar => 'BAZ'); |
109 | isa_ok($foo, 'Foo'); |
110 | is($foo->bar, 'BAZ', '... got the right parameter value'); |
8768ecf3 |
111 | } |
112 | |
565f0cbb |
113 | # NOTE: |
114 | # check that the constructor correctly handles inheritance |
115 | { |
116 | my $bar = Bar->new(); |
117 | isa_ok($bar, 'Bar'); |
8768ecf3 |
118 | isa_ok($bar, 'Foo'); |
565f0cbb |
119 | is($bar->bar, 'BAR', '... got the right inherited parameter value'); |
8768ecf3 |
120 | is($bar->baz, 'BAZ', '... got the right inherited parameter value'); |
121 | } |
122 | |
d90b42a6 |
123 | # check out accessors too |
124 | { |
125 | my $bar_accessor = $meta->get_method('bar'); |
126 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
127 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
128 | |
129 | ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); |
d90b42a6 |
130 | } |
131 | } |
132 | |
133 | { |
134 | my $meta = Bar->meta; |
135 | is($meta->name, 'Bar', '... checking the Bar metaclass'); |
8768ecf3 |
136 | |
d90b42a6 |
137 | { |
138 | my $bar_accessor = $meta->find_method_by_name('bar'); |
139 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
140 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
141 | |
142 | ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); |
143 | |
d90b42a6 |
144 | my $baz_accessor = $meta->get_method('baz'); |
145 | isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
146 | isa_ok($baz_accessor, 'Class::MOP::Method'); |
147 | |
148 | ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined'); |
d90b42a6 |
149 | } |
8768ecf3 |
150 | |
151 | ok(!$meta->is_immutable, '... our class is not immutable'); |
d90b42a6 |
152 | |
153 | lives_ok { |
154 | $meta->make_immutable( |
155 | inline_constructor => 1, |
8768ecf3 |
156 | inline_accessors => 1, |
d90b42a6 |
157 | ); |
158 | } '... changed Bar to be immutable'; |
159 | |
8768ecf3 |
160 | ok($meta->is_immutable, '... our class is now immutable'); |
161 | isa_ok($meta, 'Class::MOP::Class'); |
162 | |
d90b42a6 |
163 | # they made a constructor for us :) |
164 | can_ok('Bar', 'new'); |
8768ecf3 |
165 | |
d90b42a6 |
166 | { |
167 | my $bar = Bar->new; |
168 | isa_ok($bar, 'Bar'); |
169 | is($bar->bar, 'BAR', '... got the right default value'); |
8768ecf3 |
170 | is($bar->baz, 'BAZ', '... got the right default value'); |
d90b42a6 |
171 | } |
8768ecf3 |
172 | |
d90b42a6 |
173 | { |
174 | my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!'); |
175 | isa_ok($bar, 'Bar'); |
176 | is($bar->bar, 'BAZ!', '... got the right parameter value'); |
8768ecf3 |
177 | is($bar->baz, 'BAR!', '... got the right parameter value'); |
178 | } |
d90b42a6 |
179 | |
180 | # check out accessors too |
181 | { |
182 | my $bar_accessor = $meta->find_method_by_name('bar'); |
183 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
184 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
185 | |
186 | ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); |
187 | |
d90b42a6 |
188 | my $baz_accessor = $meta->get_method('baz'); |
189 | isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
190 | isa_ok($baz_accessor, 'Class::MOP::Method'); |
191 | |
192 | ok($baz_accessor->is_inline, '... the baz accessor is not inlined'); |
d90b42a6 |
193 | } |
194 | } |
195 | |
196 | { |
197 | my $meta = Baz->meta; |
198 | is($meta->name, 'Baz', '... checking the Bar metaclass'); |
8768ecf3 |
199 | |
d90b42a6 |
200 | { |
201 | my $bar_accessor = $meta->find_method_by_name('bar'); |
202 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
203 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
204 | |
205 | ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); |
206 | |
d90b42a6 |
207 | my $baz_accessor = $meta->find_method_by_name('baz'); |
208 | isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
209 | isa_ok($baz_accessor, 'Class::MOP::Method'); |
210 | |
211 | ok($baz_accessor->is_inline, '... the baz accessor is inlined'); |
212 | |
d90b42a6 |
213 | my $bah_accessor = $meta->get_method('bah'); |
214 | isa_ok($bah_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
215 | isa_ok($bah_accessor, 'Class::MOP::Method'); |
216 | |
217 | ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined'); |
d90b42a6 |
218 | } |
8768ecf3 |
219 | |
220 | ok(!$meta->is_immutable, '... our class is not immutable'); |
d90b42a6 |
221 | |
222 | lives_ok { |
223 | $meta->make_immutable( |
224 | inline_constructor => 0, |
8768ecf3 |
225 | inline_accessors => 1, |
d90b42a6 |
226 | ); |
227 | } '... changed Bar to be immutable'; |
228 | |
8768ecf3 |
229 | ok($meta->is_immutable, '... our class is now immutable'); |
230 | isa_ok($meta, 'Class::MOP::Class'); |
231 | |
d90b42a6 |
232 | ok(!Baz->meta->has_method('new'), '... no constructor was made'); |
8768ecf3 |
233 | |
d90b42a6 |
234 | { |
235 | my $baz = Baz->meta->construct_instance; |
236 | isa_ok($baz, 'Bar'); |
237 | is($baz->bar, 'BAR', '... got the right default value'); |
8768ecf3 |
238 | is($baz->baz, 'BAZ', '... got the right default value'); |
d90b42a6 |
239 | } |
8768ecf3 |
240 | |
d90b42a6 |
241 | { |
242 | my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!'); |
243 | isa_ok($baz, 'Baz'); |
244 | is($baz->bar, 'BAZ!', '... got the right parameter value'); |
245 | is($baz->baz, 'BAR!', '... got the right parameter value'); |
8768ecf3 |
246 | is($baz->bah, 'BAH!', '... got the right parameter value'); |
247 | } |
d90b42a6 |
248 | |
249 | # check out accessors too |
250 | { |
251 | my $bar_accessor = $meta->find_method_by_name('bar'); |
252 | isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
253 | isa_ok($bar_accessor, 'Class::MOP::Method'); |
254 | |
255 | ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); |
256 | |
d90b42a6 |
257 | my $baz_accessor = $meta->find_method_by_name('baz'); |
258 | isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
259 | isa_ok($baz_accessor, 'Class::MOP::Method'); |
260 | |
261 | ok($baz_accessor->is_inline, '... the baz accessor is not inlined'); |
d90b42a6 |
262 | |
263 | my $bah_accessor = $meta->get_method('bah'); |
264 | isa_ok($bah_accessor, 'Class::MOP::Method::Accessor'); |
8768ecf3 |
265 | isa_ok($bah_accessor, 'Class::MOP::Method'); |
266 | |
267 | ok($bah_accessor->is_inline, '... the baz accessor is not inlined'); |
d90b42a6 |
268 | } |
269 | } |
270 | |
8768ecf3 |
271 | |
272 | { |
273 | my $buzz; |
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'); |
278 | |
279 | $buzz->bar(undef); |
280 | ::ok($buzz->has_bar, '...bar is set'); |
281 | ::is($buzz->bar, undef, '...bar is undef'); |
282 | $buzz->clear_bar; |
283 | ::ok(!$buzz->has_bar, '...bar is no longerset'); |
284 | |
285 | my $buzz2; |
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'); |
289 | |
290 | } |
291 | |
292 | { |
293 | my $buzz; |
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"' ); |
297 | |
298 | my $buzz2; |
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'); |
302 | |
303 | } |