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