Re: [Another bug] Re: about Storable perl module (again)
[p5sagit/p5-mst-13.2.git] / ext / Storable / t / store.t
CommitLineData
7a6a85bf 1#!./perl
2
9e21b3d0 3# $Id: store.t,v 1.0 2000/09/01 19:40:42 ram Exp $
7a6a85bf 4#
5# Copyright (c) 1995-2000, Raphael Manfredi
6#
9e21b3d0 7# You may redistribute only under the same terms as Perl 5, as specified
8# in the README file that comes with the distribution.
7a6a85bf 9#
10# $Log: store.t,v $
9e21b3d0 11# Revision 1.0 2000/09/01 19:40:42 ram
12# Baseline for first official release.
7a6a85bf 13#
14
15sub BEGIN {
0c384302 16 if ($ENV{PERL_CORE}){
17 chdir('t') if -d 't';
7dadce44 18 @INC = ('.', '../lib', '../ext/Storable/t');
372cb964 19 } else {
20 unshift @INC, 't';
0c384302 21 }
9f233367 22 require Config; import Config;
0c384302 23 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
9f233367 24 print "1..0 # Skip: Storable was not built\n";
25 exit 0;
26 }
372cb964 27 require 'st-dump.pl';
7a6a85bf 28}
29
9e21b3d0 30use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
7a6a85bf 31
32print "1..20\n";
33
34$a = 'toto';
35$b = \$a;
36$c = bless {}, CLASS;
37$c->{attribute} = 'attrval';
38%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
39@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
40 $b, \$a, $a, $c, \$c, \%a);
41
42print "not " unless defined store(\@a, 'store');
43print "ok 1\n";
44
45$dumped = &dump(\@a);
46print "ok 2\n";
47
48$root = retrieve('store');
49print "not " unless defined $root;
50print "ok 3\n";
51
52$got = &dump($root);
53print "ok 4\n";
54
55print "not " unless $got eq $dumped;
56print "ok 5\n";
57
29fc1735 581 while unlink 'store';
7a6a85bf 59
60package FOO; @ISA = qw(Storable);
61
62sub make {
63 my $self = bless {};
64 $self->{key} = \%main::a;
65 return $self;
66};
67
68package main;
69
70$foo = FOO->make;
71print "not " unless $foo->store('store');
72print "ok 6\n";
73
74print "not " unless open(OUT, '>>store');
75print "ok 7\n";
76binmode OUT;
77
78print "not " unless defined store_fd(\@a, ::OUT);
79print "ok 8\n";
80print "not " unless defined nstore_fd($foo, ::OUT);
81print "ok 9\n";
82print "not " unless defined nstore_fd(\%a, ::OUT);
83print "ok 10\n";
84
85print "not " unless close(OUT);
86print "ok 11\n";
87
88print "not " unless open(OUT, 'store');
89binmode OUT;
90
9e21b3d0 91$r = fd_retrieve(::OUT);
7a6a85bf 92print "not " unless defined $r;
93print "ok 12\n";
94print "not " unless &dump($foo) eq &dump($r);
95print "ok 13\n";
96
9e21b3d0 97$r = fd_retrieve(::OUT);
7a6a85bf 98print "not " unless defined $r;
99print "ok 14\n";
100print "not " unless &dump(\@a) eq &dump($r);
101print "ok 15\n";
102
9e21b3d0 103$r = fd_retrieve(main::OUT);
7a6a85bf 104print "not " unless defined $r;
105print "ok 16\n";
106print "not " unless &dump($foo) eq &dump($r);
107print "ok 17\n";
108
9e21b3d0 109$r = fd_retrieve(::OUT);
7a6a85bf 110print "not " unless defined $r;
111print "ok 18\n";
112print "not " unless &dump(\%a) eq &dump($r);
113print "ok 19\n";
114
9e21b3d0 115eval { $r = fd_retrieve(::OUT); };
7a6a85bf 116print "not " unless $@;
117print "ok 20\n";
118
d1e4d418 119close OUT or die "Could not close: $!";
29fc1735 120END { 1 while unlink 'store' }
7a6a85bf 121
122