store.t revision 1.1.1.2 
1#!./perl
2#
3#  Copyright (c) 1995-2000, Raphael Manfredi
4#  
5#  You may redistribute only under the same terms as Perl 5, as specified
6#  in the README file that comes with the distribution.
7#
8
9sub BEGIN {
10    unshift @INC, 't';
11    unshift @INC, 't/compat' if $] < 5.006002;
12    require Config; import Config;
13    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
14        print "1..0 # Skip: Storable was not built\n";
15        exit 0;
16    }
17    require 'st-dump.pl';
18}
19
20use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
21
22use Test::More tests => 21;
23
24$a = 'toto';
25$b = \$a;
26$c = bless {}, CLASS;
27$c->{attribute} = 'attrval';
28%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
29@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
30	$b, \$a, $a, $c, \$c, \%a);
31
32isnt(store(\@a, 'store'), undef);
33
34$dumped = &dump(\@a);
35isnt($dumped, undef);
36
37$root = retrieve('store');
38isnt($root, undef);
39
40$got = &dump($root);
41isnt($got, undef);
42
43is($got, $dumped);
44
451 while unlink 'store';
46
47package FOO; @ISA = qw(Storable);
48
49sub make {
50	my $self = bless {};
51	$self->{key} = \%main::a;
52	return $self;
53};
54
55package main;
56
57$foo = FOO->make;
58isnt($foo->store('store'), undef);
59
60isnt(open(OUT, '>>store'), undef);
61binmode OUT;
62
63isnt(store_fd(\@a, ::OUT), undef);
64isnt(nstore_fd($foo, ::OUT), undef);
65isnt(nstore_fd(\%a, ::OUT), undef);
66
67isnt(close(OUT), undef);
68
69isnt(open(OUT, 'store'), undef);
70
71$r = fd_retrieve(::OUT);
72isnt($r, undef);
73is(&dump($r), &dump($foo));
74
75$r = fd_retrieve(::OUT);
76isnt($r, undef);
77is(&dump($r), &dump(\@a));
78
79$r = fd_retrieve(main::OUT);
80isnt($r, undef);
81is(&dump($r), &dump($foo));
82
83$r = fd_retrieve(::OUT);
84isnt($r, undef);
85is(&dump($r), &dump(\%a));
86
87eval { $r = fd_retrieve(::OUT); };
88isnt($@, '');
89
90close OUT or die "Could not close: $!";
91END { 1 while unlink 'store' }
92