Re: [Another bug] Re: about Storable perl module (again)
[p5sagit/p5-mst-13.2.git] / ext / Storable / t / retrieve.t
CommitLineData
7a6a85bf 1#!./perl
2
9e21b3d0 3# $Id: retrieve.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: retrieve.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
30
31use Storable qw(store retrieve nstore);
32
33print "1..14\n";
34
35$a = 'toto';
36$b = \$a;
37$c = bless {}, CLASS;
38$c->{attribute} = 'attrval';
39%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
40@a = ('first', '', undef, 3, -4, -3.14159, 456, 4.5,
41 $b, \$a, $a, $c, \$c, \%a);
42
43print "not " unless defined store(\@a, 'store');
44print "ok 1\n";
45print "not " if Storable::last_op_in_netorder();
46print "ok 2\n";
47print "not " unless defined nstore(\@a, 'nstore');
48print "ok 3\n";
49print "not " unless Storable::last_op_in_netorder();
50print "ok 4\n";
51print "not " unless Storable::last_op_in_netorder();
52print "ok 5\n";
53
54$root = retrieve('store');
55print "not " unless defined $root;
56print "ok 6\n";
57print "not " if Storable::last_op_in_netorder();
58print "ok 7\n";
59
60$nroot = retrieve('nstore');
61print "not " unless defined $nroot;
62print "ok 8\n";
63print "not " unless Storable::last_op_in_netorder();
64print "ok 9\n";
65
66$d1 = &dump($root);
67print "ok 10\n";
68$d2 = &dump($nroot);
69print "ok 11\n";
70
71print "not " unless $d1 eq $d2;
72print "ok 12\n";
73
74# Make sure empty string is defined at retrieval time
75print "not " unless defined $root->[1];
76print "ok 13\n";
77print "not " if length $root->[1];
78print "ok 14\n";
79
29fc1735 80END { 1 while unlink('store', 'nstore') }
7a6a85bf 81