t/lib/st-store.t

   1 #!./perl
   2
   3 # $Id: store.t,v 0.7 2000/08/03 22:04:45 ram Exp $
   4 #
   5 #  Copyright (c) 1995-2000, Raphael Manfredi
   6 #
   7 #  You may redistribute only under the terms of the Artistic License,
   8 #  as specified in the README file that comes with the distribution.
   9 #
  10 # $Log: store.t,v $
  11 # Revision 0.7  2000/08/03 22:04:45  ram
  12 # Baseline for second beta release.
  13 #
  14
  15 sub BEGIN {
  16     chdir('t') if -d 't';
  17     unshift @INC, '../lib';
  18     require 'lib/st-dump.pl';
  19 }
  20
  21
  22 use Storable qw(store retrieve store_fd nstore_fd retrieve_fd);
  23
  24 print "1..20\n";
  25
  26 $a = 'toto';
  27 $b = \$a;
  28 $c = bless {}, CLASS;
  29 $c->{attribute} = 'attrval';
  30 %a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
  31 @a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
  32         $b, \$a, $a, $c, \$c, \%a);
  33
  34 print "not " unless defined store(\@a, 'store');
  35 print "ok 1\n";
  36
  37 $dumped = &dump(\@a);
  38 print "ok 2\n";
  39
  40 $root = retrieve('store');
  41 print "not " unless defined $root;
  42 print "ok 3\n";
  43
  44 $got = &dump($root);
  45 print "ok 4\n";
  46
  47 print "not " unless $got eq $dumped;
  48 print "ok 5\n";
  49
  50 unlink 'store';
  51
  52 package FOO; @ISA = qw(Storable);
  53
  54 sub make {
  55         my $self = bless {};
  56         $self->{key} = \%main::a;
  57         return $self;
  58 };
  59
  60 package main;
  61
  62 $foo = FOO->make;
  63 print "not " unless $foo->store('store');
  64 print "ok 6\n";
  65
  66 print "not " unless open(OUT, '>>store');
  67 print "ok 7\n";
  68 binmode OUT;
  69
  70 print "not " unless defined store_fd(\@a, ::OUT);
  71 print "ok 8\n";
  72 print "not " unless defined nstore_fd($foo, ::OUT);
  73 print "ok 9\n";
  74 print "not " unless defined nstore_fd(\%a, ::OUT);
  75 print "ok 10\n";
  76
  77 print "not " unless close(OUT);
  78 print "ok 11\n";
  79
  80 print "not " unless open(OUT, 'store');
  81 binmode OUT;
  82
  83 $r = retrieve_fd(::OUT);
  84 print "not " unless defined $r;
  85 print "ok 12\n";
  86 print "not " unless &dump($foo) eq &dump($r);
  87 print "ok 13\n";
  88
  89 $r = retrieve_fd(::OUT);
  90 print "not " unless defined $r;
  91 print "ok 14\n";
  92 print "not " unless &dump(\@a) eq &dump($r);
  93 print "ok 15\n";
  94
  95 $r = retrieve_fd(main::OUT);
  96 print "not " unless defined $r;
  97 print "ok 16\n";
  98 print "not " unless &dump($foo) eq &dump($r);
  99 print "ok 17\n";
 100
 101 $r = retrieve_fd(::OUT);
 102 print "not " unless defined $r;
 103 print "ok 18\n";
 104 print "not " unless &dump(\%a) eq &dump($r);
 105 print "ok 19\n";
 106
 107 eval { $r = retrieve_fd(::OUT); };
 108 print "not " unless $@;
 109 print "ok 20\n";
 110
 111 close OUT;
 112 END { unlink 'store' }
 113
 114