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