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