dist/Storable/t/compat01.t

   1 #!perl -w
   2
   3 BEGIN {
   4     unshift @INC, 't';
   5     require Config; import Config;
   6     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
   7         print "1..0 # Skip: Storable was not built\n";
   8         exit 0;
   9     }
  10
  11     use Config;
  12     if ($Config{byteorder} ne "1234") {
  13         print "1..0 # Skip: Test only works for 32 bit little-ending machines\n";
  14         exit 0;
  15     }
  16 }
  17
  18 use strict;
  19 use Storable qw(retrieve);
  20
  21 my $file = "xx-$$.pst";
  22 my @dumps = (
  23     # some sample dumps of the hash { one => 1 }
  24     "perl-store\x041234\4\4\4\x94y\22\b\3\1\0\0\0vxz\22\b\1\1\0\0\x001Xk\3\0\0\0oneX", # 0.1
  25     "perl-store\0\x041234\4\4\4\x94y\22\b\3\1\0\0\0vxz\22\b\b\x81Xk\3\0\0\0oneX",      # 0.4@7
  26 );
  27
  28 print "1.." . @dumps . "\n";
  29
  30 my $testno;
  31 for my $dump (@dumps) {
  32     $testno++;
  33
  34     open(FH, ">$file") || die "Can't create $file: $!";
  35     binmode(FH);
  36     print FH $dump;
  37     close(FH) || die "Can't write $file: $!";
  38
  39     eval {
  40         my $data = retrieve($file);
  41         if (ref($data) eq "HASH" && $data->{one} eq "1") {
  42             print "ok $testno\n";
  43         }
  44         else {
  45             print "not ok $testno\n";
  46         }
  47     };
  48     warn $@ if $@;
  49
  50     unlink($file);
  51 }