Commit | Line | Data |
857f87a7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
d9586da2 |
6 | use Test::More tests => 83; |
857f87a7 |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
857f87a7 |
11 | } |
12 | |
13 | { |
14 | package Foo; |
0ac992ee |
15 | |
857f87a7 |
16 | use strict; |
17 | use warnings; |
18 | use metaclass; |
0ac992ee |
19 | |
857f87a7 |
20 | __PACKAGE__->meta->add_attribute('bar'); |
0ac992ee |
21 | |
857f87a7 |
22 | package Bar; |
0ac992ee |
23 | |
857f87a7 |
24 | use strict; |
25 | use warnings; |
26 | use metaclass; |
0ac992ee |
27 | |
857f87a7 |
28 | __PACKAGE__->meta->superclasses('Foo'); |
29 | |
0ac992ee |
30 | __PACKAGE__->meta->add_attribute('baz'); |
31 | |
857f87a7 |
32 | package Baz; |
0ac992ee |
33 | |
857f87a7 |
34 | use strict; |
35 | use warnings; |
36 | use metaclass; |
0ac992ee |
37 | |
857f87a7 |
38 | __PACKAGE__->meta->superclasses('Bar'); |
39 | |
0ac992ee |
40 | __PACKAGE__->meta->add_attribute('bah'); |
857f87a7 |
41 | } |
42 | |
43 | { |
d9586da2 |
44 | my $meta = Foo->meta; |
45 | |
46 | my $transformer; |
47 | lives_ok{ $transformer = $meta->create_immutable_transformer } |
48 | "Created immutable transformer"; |
49 | isa_ok($transformer, 'Class::MOP::Immutable', '... transformer isa Class::MOP::Immutable'); |
50 | my $methods = $transformer->create_methods_for_immutable_metaclass; |
51 | |
52 | my $immutable_metaclass = $transformer->immutable_metaclass; |
53 | is($transformer->metaclass, $meta, '... transformer has correct metaclass'); |
54 | ok($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class'); |
55 | |
56 | #I don't understand why i need to ->meta here... |
57 | my $obj = $immutable_metaclass->name; |
58 | ok(!$obj->is_mutable, '... immutable_metaclass is not mutable'); |
59 | ok($obj->is_immutable, '... immutable_metaclass is immutable'); |
60 | ok(!$obj->make_immutable, '... immutable_metaclass make_mutable is noop'); |
61 | is($obj->meta, $immutable_metaclass, '... immutable_metaclass meta hack works'); |
62 | |
63 | is_deeply( |
64 | [ $immutable_metaclass->superclasses ], |
65 | [ $meta->blessed ], |
66 | '... immutable_metaclass superclasses are correct' |
67 | ); |
68 | ok($immutable_metaclass->has_method('get_mutable_metaclass_name')); |
69 | |
70 | } |
71 | |
72 | { |
857f87a7 |
73 | my $meta = Foo->meta; |
74 | is($meta->name, 'Foo', '... checking the Foo metaclass'); |
0ac992ee |
75 | |
857f87a7 |
76 | ok($meta->is_mutable, '... our class is mutable'); |
0ac992ee |
77 | ok(!$meta->is_immutable, '... our class is not immutable'); |
857f87a7 |
78 | |
79 | lives_ok { |
80 | $meta->make_immutable(); |
81 | } '... changed Foo to be immutable'; |
0ac992ee |
82 | |
857f87a7 |
83 | ok(!$meta->make_immutable, '... make immutable now returns nothing'); |
0ac992ee |
84 | |
857f87a7 |
85 | ok(!$meta->is_mutable, '... our class is no longer mutable'); |
0ac992ee |
86 | ok($meta->is_immutable, '... our class is now immutable'); |
857f87a7 |
87 | |
857f87a7 |
88 | isa_ok($meta, 'Class::MOP::Class'); |
0ac992ee |
89 | |
857f87a7 |
90 | dies_ok { $meta->add_method() } '... exception thrown as expected'; |
91 | dies_ok { $meta->alias_method() } '... exception thrown as expected'; |
92 | dies_ok { $meta->remove_method() } '... exception thrown as expected'; |
0ac992ee |
93 | |
857f87a7 |
94 | dies_ok { $meta->add_attribute() } '... exception thrown as expected'; |
95 | dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; |
0ac992ee |
96 | |
58d75218 |
97 | dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; |
98 | dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; |
857f87a7 |
99 | |
100 | my @supers; |
101 | lives_ok { |
102 | @supers = $meta->superclasses; |
103 | } '... got the superclasses okay'; |
104 | |
105 | dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; |
0ac992ee |
106 | |
857f87a7 |
107 | my $meta_instance; |
108 | lives_ok { |
109 | $meta_instance = $meta->get_meta_instance; |
110 | } '... got the meta instance okay'; |
111 | isa_ok($meta_instance, 'Class::MOP::Instance'); |
112 | is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); |
0ac992ee |
113 | |
857f87a7 |
114 | my @cpl; |
115 | lives_ok { |
116 | @cpl = $meta->class_precedence_list; |
0ac992ee |
117 | } '... got the class precedence list okay'; |
857f87a7 |
118 | is_deeply( |
119 | \@cpl, |
120 | [ 'Foo' ], |
121 | '... we just have ourselves in the class precedence list'); |
0ac992ee |
122 | |
857f87a7 |
123 | my @attributes; |
124 | lives_ok { |
125 | @attributes = $meta->compute_all_applicable_attributes; |
126 | } '... got the attribute list okay'; |
127 | is_deeply( |
128 | \@attributes, |
129 | [ $meta->get_attribute('bar') ], |
130 | '... got the right list of attributes'); |
131 | } |
132 | |
133 | { |
134 | my $meta = Bar->meta; |
0ac992ee |
135 | is($meta->name, 'Bar', '... checking the Bar metaclass'); |
136 | |
857f87a7 |
137 | ok($meta->is_mutable, '... our class is mutable'); |
0ac992ee |
138 | ok(!$meta->is_immutable, '... our class is not immutable'); |
857f87a7 |
139 | |
140 | lives_ok { |
141 | $meta->make_immutable(); |
142 | } '... changed Bar to be immutable'; |
0ac992ee |
143 | |
857f87a7 |
144 | ok(!$meta->make_immutable, '... make immutable now returns nothing'); |
0ac992ee |
145 | |
857f87a7 |
146 | ok(!$meta->is_mutable, '... our class is no longer mutable'); |
0ac992ee |
147 | ok($meta->is_immutable, '... our class is now immutable'); |
857f87a7 |
148 | |
857f87a7 |
149 | isa_ok($meta, 'Class::MOP::Class'); |
0ac992ee |
150 | |
857f87a7 |
151 | dies_ok { $meta->add_method() } '... exception thrown as expected'; |
152 | dies_ok { $meta->alias_method() } '... exception thrown as expected'; |
153 | dies_ok { $meta->remove_method() } '... exception thrown as expected'; |
0ac992ee |
154 | |
857f87a7 |
155 | dies_ok { $meta->add_attribute() } '... exception thrown as expected'; |
156 | dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; |
0ac992ee |
157 | |
58d75218 |
158 | dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; |
159 | dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; |
857f87a7 |
160 | |
161 | my @supers; |
162 | lives_ok { |
163 | @supers = $meta->superclasses; |
164 | } '... got the superclasses okay'; |
165 | |
166 | dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; |
0ac992ee |
167 | |
857f87a7 |
168 | my $meta_instance; |
169 | lives_ok { |
170 | $meta_instance = $meta->get_meta_instance; |
171 | } '... got the meta instance okay'; |
172 | isa_ok($meta_instance, 'Class::MOP::Instance'); |
0ac992ee |
173 | is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); |
174 | |
857f87a7 |
175 | my @cpl; |
176 | lives_ok { |
177 | @cpl = $meta->class_precedence_list; |
0ac992ee |
178 | } '... got the class precedence list okay'; |
857f87a7 |
179 | is_deeply( |
180 | \@cpl, |
181 | [ 'Bar', 'Foo'], |
182 | '... we just have ourselves in the class precedence list'); |
0ac992ee |
183 | |
857f87a7 |
184 | my @attributes; |
185 | lives_ok { |
186 | @attributes = $meta->compute_all_applicable_attributes; |
187 | } '... got the attribute list okay'; |
188 | is_deeply( |
189 | [ sort { $a->name cmp $b->name } @attributes ], |
190 | [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ], |
191 | '... got the right list of attributes'); |
192 | } |
193 | |
194 | { |
195 | my $meta = Baz->meta; |
0ac992ee |
196 | is($meta->name, 'Baz', '... checking the Baz metaclass'); |
197 | |
857f87a7 |
198 | ok($meta->is_mutable, '... our class is mutable'); |
0ac992ee |
199 | ok(!$meta->is_immutable, '... our class is not immutable'); |
857f87a7 |
200 | |
201 | lives_ok { |
202 | $meta->make_immutable(); |
203 | } '... changed Baz to be immutable'; |
0ac992ee |
204 | |
857f87a7 |
205 | ok(!$meta->make_immutable, '... make immutable now returns nothing'); |
0ac992ee |
206 | |
857f87a7 |
207 | ok(!$meta->is_mutable, '... our class is no longer mutable'); |
0ac992ee |
208 | ok($meta->is_immutable, '... our class is now immutable'); |
857f87a7 |
209 | |
857f87a7 |
210 | isa_ok($meta, 'Class::MOP::Class'); |
0ac992ee |
211 | |
857f87a7 |
212 | dies_ok { $meta->add_method() } '... exception thrown as expected'; |
213 | dies_ok { $meta->alias_method() } '... exception thrown as expected'; |
214 | dies_ok { $meta->remove_method() } '... exception thrown as expected'; |
0ac992ee |
215 | |
857f87a7 |
216 | dies_ok { $meta->add_attribute() } '... exception thrown as expected'; |
217 | dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; |
0ac992ee |
218 | |
58d75218 |
219 | dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; |
220 | dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; |
857f87a7 |
221 | |
222 | my @supers; |
223 | lives_ok { |
224 | @supers = $meta->superclasses; |
225 | } '... got the superclasses okay'; |
226 | |
227 | dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; |
0ac992ee |
228 | |
857f87a7 |
229 | my $meta_instance; |
230 | lives_ok { |
231 | $meta_instance = $meta->get_meta_instance; |
232 | } '... got the meta instance okay'; |
233 | isa_ok($meta_instance, 'Class::MOP::Instance'); |
0ac992ee |
234 | is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); |
235 | |
857f87a7 |
236 | my @cpl; |
237 | lives_ok { |
238 | @cpl = $meta->class_precedence_list; |
0ac992ee |
239 | } '... got the class precedence list okay'; |
857f87a7 |
240 | is_deeply( |
241 | \@cpl, |
242 | [ 'Baz', 'Bar', 'Foo'], |
243 | '... we just have ourselves in the class precedence list'); |
0ac992ee |
244 | |
857f87a7 |
245 | my @attributes; |
246 | lives_ok { |
247 | @attributes = $meta->compute_all_applicable_attributes; |
248 | } '... got the attribute list okay'; |
249 | is_deeply( |
250 | [ sort { $a->name cmp $b->name } @attributes ], |
251 | [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ], |
252 | '... got the right list of attributes'); |
253 | } |
254 | |
255 | |