Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | |
7 | use Class::MOP; |
8 | |
9 | { |
10 | package Foo; |
11 | |
12 | use strict; |
13 | use warnings; |
14 | use metaclass; |
15 | |
16 | __PACKAGE__->meta->add_attribute('bar'); |
17 | |
18 | package Bar; |
19 | |
20 | use strict; |
21 | use warnings; |
22 | use metaclass; |
23 | |
24 | __PACKAGE__->meta->superclasses('Foo'); |
25 | |
26 | __PACKAGE__->meta->add_attribute('baz'); |
27 | |
28 | package Baz; |
29 | |
30 | use strict; |
31 | use warnings; |
32 | use metaclass; |
33 | |
34 | __PACKAGE__->meta->superclasses('Bar'); |
35 | |
36 | __PACKAGE__->meta->add_attribute('bah'); |
37 | } |
38 | |
39 | { |
40 | my $meta = Foo->meta; |
41 | my $original_metaclass_name = ref $meta; |
42 | |
43 | is_deeply( |
44 | { $meta->immutable_options }, {}, |
45 | 'immutable_options is empty before a class is made_immutable' |
46 | ); |
47 | |
48 | $meta->make_immutable; |
00b7f207 |
49 | my $line = __LINE__ - 1; |
38bf2a25 |
50 | |
51 | my $immutable_metaclass = $meta->_immutable_metaclass->meta; |
52 | |
53 | my $immutable_class_name = $immutable_metaclass->name; |
54 | |
55 | ok( !$immutable_class_name->is_mutable, '... immutable_metaclass is not mutable' ); |
56 | ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' ); |
57 | is( $immutable_class_name->meta, $immutable_metaclass, |
58 | '... immutable_metaclass meta hack works' ); |
59 | |
60 | is_deeply( |
61 | { $meta->immutable_options }, |
62 | { |
63 | inline_accessors => 1, |
64 | inline_constructor => 1, |
65 | inline_destructor => 0, |
66 | debug => 0, |
67 | immutable_trait => 'Class::MOP::Class::Immutable::Trait', |
68 | constructor_name => 'new', |
69 | constructor_class => 'Class::MOP::Method::Constructor', |
70 | destructor_class => undef, |
00b7f207 |
71 | file => $0, |
72 | line => $line, |
38bf2a25 |
73 | }, |
74 | 'immutable_options is empty before a class is made_immutable' |
75 | ); |
76 | |
77 | isa_ok( $meta, "Class::MOP::Class" ); |
78 | } |
79 | |
80 | { |
81 | my $meta = Foo->meta; |
82 | is( $meta->name, 'Foo', '... checking the Foo metaclass' ); |
83 | |
84 | ok( !$meta->is_mutable, '... our class is not mutable' ); |
85 | ok( $meta->is_immutable, '... our class is immutable' ); |
86 | |
87 | isa_ok( $meta, 'Class::MOP::Class' ); |
88 | |
89 | isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); |
90 | isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); |
91 | isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); |
92 | |
93 | isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); |
94 | isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); |
95 | |
96 | isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); |
97 | isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' ); |
98 | |
99 | is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' ); |
100 | |
101 | my @supers; |
102 | is( exception { |
103 | @supers = $meta->superclasses; |
104 | }, undef, '... got the superclasses okay' ); |
105 | |
106 | isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); |
107 | |
108 | my $meta_instance; |
109 | is( exception { |
110 | $meta_instance = $meta->get_meta_instance; |
111 | }, undef, '... got the meta instance okay' ); |
112 | isa_ok( $meta_instance, 'Class::MOP::Instance' ); |
113 | is( $meta_instance, $meta->get_meta_instance, |
114 | '... and we know it is cached' ); |
115 | |
116 | my @cpl; |
117 | is( exception { |
118 | @cpl = $meta->class_precedence_list; |
119 | }, undef, '... got the class precedence list okay' ); |
120 | is_deeply( |
121 | \@cpl, |
122 | ['Foo'], |
123 | '... we just have ourselves in the class precedence list' |
124 | ); |
125 | |
126 | my @attributes; |
127 | is( exception { |
128 | @attributes = $meta->get_all_attributes; |
129 | }, undef, '... got the attribute list okay' ); |
130 | is_deeply( |
131 | \@attributes, |
132 | [ $meta->get_attribute('bar') ], |
133 | '... got the right list of attributes' |
134 | ); |
135 | } |
136 | |
137 | { |
138 | my $meta = Bar->meta; |
139 | is( $meta->name, 'Bar', '... checking the Bar metaclass' ); |
140 | |
141 | ok( $meta->is_mutable, '... our class is mutable' ); |
142 | ok( !$meta->is_immutable, '... our class is not immutable' ); |
143 | |
144 | is( exception { |
145 | $meta->make_immutable(); |
146 | }, undef, '... changed Bar to be immutable' ); |
147 | |
148 | ok( !$meta->make_immutable, '... make immutable now returns nothing' ); |
149 | |
150 | ok( !$meta->is_mutable, '... our class is no longer mutable' ); |
151 | ok( $meta->is_immutable, '... our class is now immutable' ); |
152 | |
153 | isa_ok( $meta, 'Class::MOP::Class' ); |
154 | |
155 | isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); |
156 | isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); |
157 | isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); |
158 | |
159 | isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); |
160 | isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); |
161 | |
162 | isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); |
163 | isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' ); |
164 | |
165 | my @supers; |
166 | is( exception { |
167 | @supers = $meta->superclasses; |
168 | }, undef, '... got the superclasses okay' ); |
169 | |
170 | isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); |
171 | |
172 | my $meta_instance; |
173 | is( exception { |
174 | $meta_instance = $meta->get_meta_instance; |
175 | }, undef, '... got the meta instance okay' ); |
176 | isa_ok( $meta_instance, 'Class::MOP::Instance' ); |
177 | is( $meta_instance, $meta->get_meta_instance, |
178 | '... and we know it is cached' ); |
179 | |
180 | my @cpl; |
181 | is( exception { |
182 | @cpl = $meta->class_precedence_list; |
183 | }, undef, '... got the class precedence list okay' ); |
184 | is_deeply( |
185 | \@cpl, |
186 | [ 'Bar', 'Foo' ], |
187 | '... we just have ourselves in the class precedence list' |
188 | ); |
189 | |
190 | my @attributes; |
191 | is( exception { |
192 | @attributes = $meta->get_all_attributes; |
193 | }, undef, '... got the attribute list okay' ); |
194 | is_deeply( |
195 | [ sort { $a->name cmp $b->name } @attributes ], |
196 | [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ], |
197 | '... got the right list of attributes' |
198 | ); |
199 | } |
200 | |
201 | { |
202 | my $meta = Baz->meta; |
203 | is( $meta->name, 'Baz', '... checking the Baz metaclass' ); |
204 | |
205 | ok( $meta->is_mutable, '... our class is mutable' ); |
206 | ok( !$meta->is_immutable, '... our class is not immutable' ); |
207 | |
208 | is( exception { |
209 | $meta->make_immutable(); |
210 | }, undef, '... changed Baz to be immutable' ); |
211 | |
212 | ok( !$meta->make_immutable, '... make immutable now returns nothing' ); |
213 | |
214 | ok( !$meta->is_mutable, '... our class is no longer mutable' ); |
215 | ok( $meta->is_immutable, '... our class is now immutable' ); |
216 | |
217 | isa_ok( $meta, 'Class::MOP::Class' ); |
218 | |
219 | isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); |
220 | isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); |
221 | isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); |
222 | |
223 | isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); |
224 | isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); |
225 | |
226 | isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); |
227 | isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' ); |
228 | |
229 | my @supers; |
230 | is( exception { |
231 | @supers = $meta->superclasses; |
232 | }, undef, '... got the superclasses okay' ); |
233 | |
234 | isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); |
235 | |
236 | my $meta_instance; |
237 | is( exception { |
238 | $meta_instance = $meta->get_meta_instance; |
239 | }, undef, '... got the meta instance okay' ); |
240 | isa_ok( $meta_instance, 'Class::MOP::Instance' ); |
241 | is( $meta_instance, $meta->get_meta_instance, |
242 | '... and we know it is cached' ); |
243 | |
244 | my @cpl; |
245 | is( exception { |
246 | @cpl = $meta->class_precedence_list; |
247 | }, undef, '... got the class precedence list okay' ); |
248 | is_deeply( |
249 | \@cpl, |
250 | [ 'Baz', 'Bar', 'Foo' ], |
251 | '... we just have ourselves in the class precedence list' |
252 | ); |
253 | |
254 | my @attributes; |
255 | is( exception { |
256 | @attributes = $meta->get_all_attributes; |
257 | }, undef, '... got the attribute list okay' ); |
258 | is_deeply( |
259 | [ sort { $a->name cmp $b->name } @attributes ], |
260 | [ |
261 | $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), |
262 | Bar->meta->get_attribute('baz') |
263 | ], |
264 | '... got the right list of attributes' |
265 | ); |
266 | } |
267 | |
268 | # This test probably needs to go last since it will muck up the Foo class |
269 | { |
270 | my $meta = Foo->meta; |
271 | |
272 | $meta->make_mutable; |
273 | $meta->make_immutable( |
274 | inline_accessors => 0, |
275 | inline_constructor => 0, |
276 | constructor_name => 'newer', |
277 | ); |
00b7f207 |
278 | my $line = __LINE__ - 5; |
38bf2a25 |
279 | |
280 | is_deeply( |
281 | { $meta->immutable_options }, |
282 | { |
283 | inline_accessors => 0, |
284 | inline_constructor => 0, |
285 | inline_destructor => 0, |
286 | debug => 0, |
287 | immutable_trait => 'Class::MOP::Class::Immutable::Trait', |
288 | constructor_name => 'newer', |
289 | constructor_class => 'Class::MOP::Method::Constructor', |
290 | destructor_class => undef, |
00b7f207 |
291 | file => $0, |
292 | line => $line, |
38bf2a25 |
293 | }, |
294 | 'custom immutable_options are returned by immutable_options accessor' |
295 | ); |
296 | } |
297 | |
298 | done_testing; |