ext/Storable/t/compat01.t

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