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