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