bah, cleanup made it much slower
[gitmo/Class-MOP.git] / t / 080_meta_package.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 97;
7 use Test::Exception;
8
9 BEGIN {
10     use_ok('Class::MOP');        
11     use_ok('Class::MOP::Package');            
12 }
13
14 {
15     package Foo;
16
17     use constant SOME_CONSTANT => 1;
18     
19     sub meta { Class::MOP::Package->initialize('Foo') }
20 }
21
22 # ----------------------------------------------------------------------
23 ## tests adding a HASH
24
25 ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
26 ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
27 ok(!defined($Foo::{foo}), '... checking doesn\' vivify');
28
29 lives_ok {
30     Foo->meta->add_package_symbol('%foo' => { one => 1 });
31 } '... created %Foo::foo successfully';
32
33 # ... scalar should NOT be created here 
34
35 ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too');
36 ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too');
37 ok(!Foo->meta->has_package_symbol('&foo'), '... CODE shouldnt have been created too');
38
39 ok(defined($Foo::{foo}), '... the %foo slot was created successfully');
40 ok(Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
41
42 # check the value ...
43
44 {
45     no strict 'refs';
46     ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly');
47     is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly');
48 }
49
50 my $foo = Foo->meta->get_package_symbol('%foo');
51 is_deeply({ one => 1 }, $foo, '... got the right package variable back');
52
53 # ... make sure changes propogate up
54
55 $foo->{two} = 2;
56
57 {
58     no strict 'refs';
59     is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas');
60     
61     ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly');
62     is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly');    
63 }
64
65 # ----------------------------------------------------------------------
66 ## test adding an ARRAY
67
68 ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
69
70 lives_ok {
71     Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
72 } '... created @Foo::bar successfully';
73
74 ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
75 ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');
76
77 # ... why does this not work ... 
78
79 ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too');
80 ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too');
81 ok(!Foo->meta->has_package_symbol('&bar'), '... CODE shouldnt have been created too');
82
83 # check the value itself
84
85 {
86     no strict 'refs';
87     is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly');
88     is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly');
89 }
90
91 # ----------------------------------------------------------------------
92 ## test adding a SCALAR
93
94 ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');
95
96 lives_ok {
97     Foo->meta->add_package_symbol('$baz' => 10);
98 } '... created $Foo::baz successfully';
99
100 ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
101 ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');
102
103 ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created too');
104 ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too');
105 ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too');
106
107 is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back');   
108
109 {
110     no strict 'refs';
111     ${'Foo::baz'} = 1;
112
113     is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly');
114     is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees');    
115 }
116
117 # ----------------------------------------------------------------------
118 ## test adding a CODE
119
120 ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');
121
122 lives_ok {
123     Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
124 } '... created &Foo::funk successfully';
125
126 ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
127 ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');
128
129 ok(!Foo->meta->has_package_symbol('$funk'), '... SCALAR shouldnt have been created too');
130 ok(!Foo->meta->has_package_symbol('@funk'), '... ARRAY shouldnt have been created too');
131 ok(!Foo->meta->has_package_symbol('%funk'), '... HASH shouldnt have been created too');
132
133 {
134     no strict 'refs';
135     ok(defined &{'Foo::funk'}, '... our &funk exists');
136 }
137
138 is(Foo->funk(), 'Foo::funk', '... got the right value from the function');
139
140 # ----------------------------------------------------------------------
141 ## test multiple slots in the glob
142
143 my $ARRAY = [ 1, 2, 3 ];
144 my $CODE = sub { "Foo::foo" };
145
146 lives_ok {
147     Foo->meta->add_package_symbol('@foo' => $ARRAY);
148 } '... created @Foo::foo successfully';
149
150 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
151 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
152
153 lives_ok {
154     Foo->meta->add_package_symbol('&foo' => $CODE);
155 } '... created &Foo::foo successfully';
156
157 ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
158 is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
159
160 lives_ok {
161     Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
162 } '... created $Foo::foo successfully';
163
164 ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
165 my $SCALAR = Foo->meta->get_package_symbol('$foo');
166 is($$SCALAR, 'Foo::foo', '... got the right scalar value back');
167
168 {
169     no strict 'refs';
170     is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
171 }
172
173 lives_ok {
174     Foo->meta->remove_package_symbol('%foo');
175 } '... removed %Foo::foo successfully';
176
177 ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
178 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
179 ok(Foo->meta->has_package_symbol('&foo'), '... the &foo slot still exists');
180 ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
181
182 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
183 is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
184 is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
185
186 {
187     no strict 'refs';
188     ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
189     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');   
190     ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed');   
191     ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');            
192 }
193
194 lives_ok {
195     Foo->meta->remove_package_symbol('&foo');
196 } '... removed &Foo::foo successfully';
197
198 ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');
199
200 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
201 ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
202
203 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
204 is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
205
206 {
207     no strict 'refs';
208     ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');    
209     ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');       
210     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');   
211     ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');            
212 }
213
214 lives_ok {
215     Foo->meta->remove_package_symbol('$foo');
216 } '... removed $Foo::foo successfully';
217
218 ok(!Foo->meta->has_package_symbol('$foo'), '... the $foo slot no longer exists');
219
220 ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
221
222 is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
223
224 {
225     no strict 'refs';
226     ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');    
227     ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');   
228     ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed');                           
229     ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');    
230 }
231
232 # get_all_package_symbols
233
234 {
235     my %syms = Foo->meta->get_all_package_symbols;
236
237     is_deeply(
238         [ sort keys %syms ],
239         [ sort Foo->meta->list_all_package_symbols ],
240         '... the fetched symbols are the same as the listed ones'
241     ); 
242 }
243
244 {
245     my %syms = Foo->meta->get_all_package_symbols('CODE');
246
247     is_deeply(
248         [ sort keys %syms ],
249         [ sort Foo->meta->list_all_package_symbols('CODE') ],
250         '... the fetched symbols are the same as the listed ones'
251     );
252     
253     foreach my $symbol (keys %syms) {
254         is($syms{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol');
255     } 
256 }
257
258 {
259     Foo->meta->add_package_symbol('%zork');
260
261     my %syms = Foo->meta->get_all_package_symbols('HASH');
262
263     is_deeply(
264         [ sort keys %syms ],
265         [ sort Foo->meta->list_all_package_symbols('HASH') ],
266         '... the fetched symbols are the same as the listed ones'
267     );
268
269     foreach my $symbol (keys %syms) {
270         is($syms{$symbol}, Foo->meta->get_package_symbol('%' . $symbol), '... got the right symbol');
271     }
272
273     no warnings 'once';
274     is_deeply(
275         \%syms,
276         { zork => \%Foo::zork },
277         "got the right ones",
278     );
279 }
280 # check some errors
281
282 dies_ok {
283     Foo->meta->add_package_symbol('bar');
284 } '... no sigil for bar';
285
286 dies_ok {
287     Foo->meta->remove_package_symbol('bar');
288 } '... no sigil for bar';
289
290 dies_ok {
291     Foo->meta->get_package_symbol('bar');
292 } '... no sigil for bar';
293
294 dies_ok {
295     Foo->meta->has_package_symbol('bar');
296 } '... no sigil for bar';