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