This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / t / lib / st-retrieve.t
CommitLineData
7a6a85bf
RG
1#!./perl
2
9e21b3d0 3# $Id: retrieve.t,v 1.0 2000/09/01 19:40:42 ram Exp $
7a6a85bf
RG
4#
5# Copyright (c) 1995-2000, Raphael Manfredi
6#
9e21b3d0
JH
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
RG
9#
10# $Log: retrieve.t,v $
9e21b3d0
JH
11# Revision 1.0 2000/09/01 19:40:42 ram
12# Baseline for first official release.
7a6a85bf
RG
13#
14
15sub BEGIN {
16 chdir('t') if -d 't';
20822f61
MG
17 @INC = '.';
18 push @INC, '../lib';
9f233367
PP
19 require Config; import Config;
20 if ($Config{'extensions'} !~ /\bStorable\b/) {
21 print "1..0 # Skip: Storable was not built\n";
22 exit 0;
23 }
7a6a85bf
RG
24 require 'lib/st-dump.pl';
25}
26
27
28use Storable qw(store retrieve nstore);
29
30print "1..14\n";
31
32$a = 'toto';
33$b = \$a;
34$c = bless {}, CLASS;
35$c->{attribute} = 'attrval';
36%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
37@a = ('first', '', undef, 3, -4, -3.14159, 456, 4.5,
38 $b, \$a, $a, $c, \$c, \%a);
39
40print "not " unless defined store(\@a, 'store');
41print "ok 1\n";
42print "not " if Storable::last_op_in_netorder();
43print "ok 2\n";
44print "not " unless defined nstore(\@a, 'nstore');
45print "ok 3\n";
46print "not " unless Storable::last_op_in_netorder();
47print "ok 4\n";
48print "not " unless Storable::last_op_in_netorder();
49print "ok 5\n";
50
51$root = retrieve('store');
52print "not " unless defined $root;
53print "ok 6\n";
54print "not " if Storable::last_op_in_netorder();
55print "ok 7\n";
56
57$nroot = retrieve('nstore');
58print "not " unless defined $nroot;
59print "ok 8\n";
60print "not " unless Storable::last_op_in_netorder();
61print "ok 9\n";
62
63$d1 = &dump($root);
64print "ok 10\n";
65$d2 = &dump($nroot);
66print "ok 11\n";
67
68print "not " unless $d1 eq $d2;
69print "ok 12\n";
70
71# Make sure empty string is defined at retrieval time
72print "not " unless defined $root->[1];
73print "ok 13\n";
74print "not " if length $root->[1];
75print "ok 14\n";
76
29fc1735 77END { 1 while unlink('store', 'nstore') }
7a6a85bf 78