[perl5.git] / ext / Storable / t / malice.t

#!./perl -w
#
#  Copyright 2002, Larry Wall.
#
#  You may redistribute only under the same terms as Perl 5, as specified
#  in the README file that comes with the distribution.
#

# I'm trying to keep this test easily backwards compatible to 5.004, so no
# qr//;

# This test tries to craft malicious data to test out as many different
# error traps in Storable as possible
# It also acts as a test for read_header

sub BEGIN {
    if ($ENV{PERL_CORE}){
	chdir('t') if -d 't';
	@INC = ('.', '../lib');
    } else {
	# This lets us distribute Test::More in t/
	unshift @INC, 't';
    }
    require Config; import Config;
    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
        print "1..0 # Skip: Storable was not built\n";
        exit 0;
    }
}

use strict;
use vars qw($file_magic_str $other_magic $network_magic $byteorder
            $major $minor $minor_write $fancy);

$byteorder = $Config{byteorder};

$file_magic_str = 'pst0';
$other_magic = 7 + length $byteorder;
$network_magic = 2;
$major = 2;
$minor = 6;
$minor_write = $] > 5.007 ? 6 : 4;

use Test::More;

# If it's 5.7.3 or later the hash will be stored with flags, which is
# 2 extra bytes. There are 2 * 2 * 2 tests per byte in the body and header
# common to normal and network order serialised objects (hence the 8)
# There are only 2 * 2 tests per byte in the parts of the header not present
# for network order, and 2 tests per byte on the 'pst0' "magic number" only
# present in files, but not in things store()ed to memory
$fancy = ($] > 5.007 ? 2 : 0);

plan tests => 368 + length ($byteorder) * 4 + $fancy * 8 + 1;

use Storable qw (store retrieve freeze thaw nstore nfreeze);

my $file = "malice.$$";
die "Temporary file 'malice.$$' already exists" if -e $file;

END { while (-f $file) {unlink $file or die "Can't unlink '$file': $!" }}

# The chr 256 is a hack to force the hash to always have the utf8 keys flag
# set on 5.7.3 and later. Otherwise the test fails if run with -Mutf8 because
# only there does the hash has the flag on, and hence only there is it stored
# as a flagged hash, which is 2 bytes longer
my %hash = (perl => 'rules', chr 256, '');
delete $hash{chr 256};

sub test_hash {
  my $clone = shift;
  is (ref $clone, "HASH", "Get hash back");
  is (scalar keys %$clone, 1, "with 1 key");
  is ((keys %$clone)[0], "perl", "which is correct");
  is ($clone->{perl}, "rules");
}

sub test_header {
  my ($header, $isfile, $isnetorder) = @_;
  is (!!$header->{file}, !!$isfile, "is file");
  is ($header->{major}, $major, "major number");
  is ($header->{minor}, $minor_write, "minor number");
  is (!!$header->{netorder}, !!$isnetorder, "is network order");
  if ($isnetorder) {
    # Network order header has no sizes
  } else {
    is ($header->{byteorder}, $byteorder, "byte order");
    is ($header->{intsize}, $Config{intsize}, "int size");
    is ($header->{longsize}, $Config{longsize}, "long size");
 SKIP: {
	skip ("No \$Config{prtsize} on this perl version ($])", 1)
	    unless defined $Config{ptrsize};
	is ($header->{ptrsize}, $Config{ptrsize}, "long size");
    }
    is ($header->{nvsize}, $Config{nvsize} || $Config{doublesize} || 8,
        "nv size"); # 5.00405 doesn't even have doublesize in config.
  }
}

sub store_and_retrieve {
  my $data = shift;
  unlink $file or die "Can't unlink '$file': $!";
  open FH, ">$file" or die "Can't open '$file': $!";
  binmode FH;
  print FH $data or die "Can't print to '$file': $!";
  close FH or die "Can't close '$file': $!";

  return  eval {retrieve $file};
}

sub freeze_and_thaw {
  my $data = shift;
  return eval {thaw $data};
}

sub test_truncated {
  my ($data, $sub, $magic_len, $what) = @_;
  for my $i (0 .. length ($data) - 1) {
    my $short = substr $data, 0, $i;

    # local $Storable::DEBUGME = 1;
    my $clone = &$sub($short);
    is (defined ($clone), '', "truncated $what to $i should fail");
    if ($i < $magic_len) {
      like ($@, "/^Magic number checking on storable $what failed/",
          "Should croak with magic number warning");
    } else {
      is ($@, "", "Should not set \$\@");
    }
  }
}

sub test_corrupt {
  my ($data, $sub, $what, $name) = @_;

  my $clone = &$sub($data);
  is (defined ($clone), '', "$name $what should fail");
  like ($@, $what, $name);
}

sub test_things {
  my ($contents, $sub, $what, $isnetwork) = @_;
  my $isfile = $what eq 'file';
  my $file_magic = $isfile ? length $file_magic_str : 0;

  my $header = Storable::read_magic ($contents);
  test_header ($header, $isfile, $isnetwork);

  # Test that if we re-write it, everything still works:
  my $clone = &$sub ($contents);

  is ($@, "", "There should be no error");

  test_hash ($clone);

  # Now lets check the short version:
  test_truncated ($contents, $sub, $file_magic
                  + ($isnetwork ? $network_magic : $other_magic), $what);

  my $copy;
  if ($isfile) {
    $copy = $contents;
    substr ($copy, 0, 4) = 'iron';
    test_corrupt ($copy, $sub, "/^File is not a perl storable/",
                  "magic number");
  }

  $copy = $contents;
  # Needs to be more than 1, as we're already coding a spread of 1 minor version
  # number on writes (2.5, 2.4). May increase to 2 if we figure we can do 2.3
  # on 5.005_03 (No utf8).
  # 4 allows for a small safety margin
  # (Joke:
  # Question: What is the value of pi?
  # Mathematician answers "It's pi, isn't it"
  # Physicist answers "3.1, within experimental error"
  # Engineer answers "Well, allowing for a small safety margin,   18"
  # )
  my $minor4 = $header->{minor} + 4;
  substr ($copy, $file_magic + 1, 1) = chr $minor4;
  {
    # Now by default newer minor version numbers are not a pain.
    $clone = &$sub($copy);
    is ($@, "", "by default no error on higher minor");
    test_hash ($clone);

    local $Storable::accept_future_minor = 0;
    test_corrupt ($copy, $sub,
                  "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/",
                  "higher minor");
  }

  $copy = $contents;
  my $major1 = $header->{major} + 1;
  substr ($copy, $file_magic, 1) = chr 2*$major1;
  test_corrupt ($copy, $sub,
                "/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$minor\\)/",
                "higher major");

  # Continue messing with the previous copy
  my $minor1 = $header->{minor} - 1;
  substr ($copy, $file_magic + 1, 1) = chr $minor1;
  test_corrupt ($copy, $sub,
                "/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$minor\\)/",
              "higher major, lower minor");

  my $where;
  if (!$isnetwork) {
    # All these are omitted from the network order header.
    # I'm not sure if it's correct to omit the byte size stuff.
    $copy = $contents;
    substr ($copy, $file_magic + 3, length $header->{byteorder})
      = reverse $header->{byteorder};

    test_corrupt ($copy, $sub, "/^Byte order is not compatible/",
                  "byte order");
    $where = $file_magic + 3 + length $header->{byteorder};
    foreach (['intsize', "Integer"],
             ['longsize', "Long integer"],
             ['ptrsize', "Pointer"],
             ['nvsize', "Double"]) {
      my ($key, $name) = @$_;
      $copy = $contents;
      substr ($copy, $where++, 1) = chr 0;
      test_corrupt ($copy, $sub, "/^$name size is not compatible/",
                    "$name size");
    }
  } else {
    $where = $file_magic + $network_magic;
  }

  # Just the header and a tag 255. As 26 is currently the highest tag, this
  # is "unexpected"
  $copy = substr ($contents, 0, $where) . chr 255;

  test_corrupt ($copy, $sub,
                "/^Corrupted storable $what \\(binary v$header->{major}.$header->{minor}\\)/",
                "bogus tag");

  # Now drop the minor version number
  substr ($copy, $file_magic + 1, 1) = chr $minor1;

  test_corrupt ($copy, $sub,
                "/^Corrupted storable $what \\(binary v$header->{major}.$minor1\\)/",
                "bogus tag, minor less 1");
  # Now increase the minor version number
  substr ($copy, $file_magic + 1, 1) = chr $minor4;

  # local $Storable::DEBUGME = 1;
  # This is the delayed croak
  test_corrupt ($copy, $sub,
                "/^Storable binary image v$header->{major}.$minor4 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 26/",
                "bogus tag, minor plus 4");
  # And check again that this croak is not delayed:
  {
    # local $Storable::DEBUGME = 1;
    local $Storable::accept_future_minor = 0;
    test_corrupt ($copy, $sub,
                  "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/",
                  "higher minor");
  }
}

sub slurp {
  my $file = shift;
  local (*FH, $/);
  open FH, "<$file" or die "Can't open '$file': $!";
  binmode FH;
  my $contents = <FH>;
  die "Can't read $file: $!" unless defined $contents;
  return $contents;
}


ok (defined store(\%hash, $file));

my $expected = 20 + length ($file_magic_str) + $other_magic + $fancy;
my $length = -s $file;

die "Don't seem to have written file '$file' as I can't get its length: $!"
  unless defined $file;

die "Expected file to be $expected bytes (sizeof long is $Config{longsize}) but it is $length"
  unless $length == $expected;

# Read the contents into memory:
my $contents = slurp $file;

# Test the original direct from disk
my $clone = retrieve $file;
test_hash ($clone);

# Then test it.
test_things($contents, \&store_and_retrieve, 'file');

# And now try almost everything again with a Storable string
my $stored = freeze \%hash;
test_things($stored, \&freeze_and_thaw, 'string');

# Network order.
unlink $file or die "Can't unlink '$file': $!";

ok (defined nstore(\%hash, $file));

$expected = 20 + length ($file_magic_str) + $network_magic + $fancy;
$length = -s $file;

die "Don't seem to have written file '$file' as I can't get its length: $!"
  unless defined $file;

die "Expected file to be $expected bytes (sizeof long is $Config{longsize}) but it is $length"
  unless $length == $expected;

# Read the contents into memory:
$contents = slurp $file;

# Test the original direct from disk
$clone = retrieve $file;
test_hash ($clone);

# Then test it.
test_things($contents, \&store_and_retrieve, 'file', 1);

# And now try almost everything again with a Storable string
$stored = nfreeze \%hash;
test_things($stored, \&freeze_and_thaw, 'string', 1);

# Test that the bug fixed by #20587 doesn't affect us under some older
# Perl. AMS 20030901
{
    chop(my $a = chr(0xDF).chr(256));
    my %a = (chr(0xDF) => 1);
    $a{$a}++;
    freeze \%a;
    # If we were built with -DDEBUGGING, the assert() should have killed
    # us, which will probably alert the user that something went wrong.
    ok(1);
}
Commit	Line	Data
b8778c7c	1	#!./perl -w
b8778c7c NC	2	#
	3	# Copyright 2002, Larry Wall.
	4	#
	5	# You may redistribute only under the same terms as Perl 5, as specified
	6	# in the README file that comes with the distribution.
	7	#
	8
	9	# I'm trying to keep this test easily backwards compatible to 5.004, so no
	10	# qr//;
b8778c7c NC	11
	12	# This test tries to craft malicious data to test out as many different
	13	# error traps in Storable as possible
	14	# It also acts as a test for read_header
	15
	16	sub BEGIN {
	17	if ($ENV{PERL_CORE}){
	18	chdir('t') if -d 't';
372cb964	19	@INC = ('.', '../lib');
a2307be4 NC	20	} else {
	21	# This lets us distribute Test::More in t/
	22	unshift @INC, 't';
b8778c7c NC	23	}
	24	require Config; import Config;
	25	if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
	26	print "1..0 # Skip: Storable was not built\n";
	27	exit 0;
	28	}
b8778c7c NC	29	}
	30
	31	use strict;
677a847b NC	32	use vars qw($file_magic_str $other_magic $network_magic $byteorder
	33	$major $minor $minor_write $fancy);
	34
	35	$byteorder = $Config{byteorder};
	36
96ef0061	37	$file_magic_str = 'pst0';
677a847b	38	$other_magic = 7 + length $byteorder;
96ef0061 JH	39	$network_magic = 2;
96ef0061 JH	40	$major = 2;
464b080a SR	41	$minor = 6;
464b080a SR	42	$minor_write = $] > 5.007 ? 6 : 4;
b8778c7c	43
372cb964 NC	44	use Test::More;
	45
	46	# If it's 5.7.3 or later the hash will be stored with flags, which is
	47	# 2 extra bytes. There are 2 * 2 * 2 tests per byte in the body and header
	48	# common to normal and network order serialised objects (hence the 8)
	49	# There are only 2 * 2 tests per byte in the parts of the header not present
	50	# for network order, and 2 tests per byte on the 'pst0' "magic number" only
	51	# present in files, but not in things store()ed to memory
	52	$fancy = ($] > 5.007 ? 2 : 0);
	53
fcaa57e7	54	plan tests => 368 + length ($byteorder) * 4 + $fancy * 8 + 1;
b8778c7c NC	55
	56	use Storable qw (store retrieve freeze thaw nstore nfreeze);
	57
	58	my $file = "malice.$$";
	59	die "Temporary file 'malice.$$' already exists" if -e $file;
	60
	61	END { while (-f $file) {unlink $file or die "Can't unlink '$file': $!" }}
	62
9d80fab7 NC	63	# The chr 256 is a hack to force the hash to always have the utf8 keys flag
	64	# set on 5.7.3 and later. Otherwise the test fails if run with -Mutf8 because
	65	# only there does the hash has the flag on, and hence only there is it stored
	66	# as a flagged hash, which is 2 bytes longer
	67	my %hash = (perl => 'rules', chr 256, '');
	68	delete $hash{chr 256};
b8778c7c NC	69
	70	sub test_hash {
	71	my $clone = shift;
372cb964 NC	72	is (ref $clone, "HASH", "Get hash back");
	73	is (scalar keys %$clone, 1, "with 1 key");
	74	is ((keys %$clone)[0], "perl", "which is correct");
	75	is ($clone->{perl}, "rules");
b8778c7c NC	76	}
	77
	78	sub test_header {
	79	my ($header, $isfile, $isnetorder) = @_;
372cb964 NC	80	is (!!$header->{file}, !!$isfile, "is file");
	81	is ($header->{major}, $major, "major number");
	82	is ($header->{minor}, $minor_write, "minor number");
	83	is (!!$header->{netorder}, !!$isnetorder, "is network order");
677a847b NC	84	if ($isnetorder) {
	85	# Network order header has no sizes
	86	} else {
	87	is ($header->{byteorder}, $byteorder, "byte order");
372cb964 NC	88	is ($header->{intsize}, $Config{intsize}, "int size");
372cb964 NC	89	is ($header->{longsize}, $Config{longsize}, "long size");
a2307be4 NC	90	SKIP: {
	91	skip ("No \$Config{prtsize} on this perl version ($])", 1)
	92	unless defined $Config{ptrsize};
	93	is ($header->{ptrsize}, $Config{ptrsize}, "long size");
	94	}
372cb964	95	is ($header->{nvsize}, $Config{nvsize} \|\| $Config{doublesize} \|\| 8,
b8778c7c NC	96	"nv size"); # 5.00405 doesn't even have doublesize in config.
	97	}
	98	}
	99
	100	sub store_and_retrieve {
	101	my $data = shift;
	102	unlink $file or die "Can't unlink '$file': $!";
	103	open FH, ">$file" or die "Can't open '$file': $!";
	104	binmode FH;
	105	print FH $data or die "Can't print to '$file': $!";
	106	close FH or die "Can't close '$file': $!";
	107
	108	return eval {retrieve $file};
	109	}
	110
	111	sub freeze_and_thaw {
	112	my $data = shift;
	113	return eval {thaw $data};
	114	}
	115
	116	sub test_truncated {
	117	my ($data, $sub, $magic_len, $what) = @_;
	118	for my $i (0 .. length ($data) - 1) {
	119	my $short = substr $data, 0, $i;
	120
a2307be4	121	# local $Storable::DEBUGME = 1;
b8778c7c	122	my $clone = &$sub($short);
372cb964	123	is (defined ($clone), '', "truncated $what to $i should fail");
b8778c7c	124	if ($i < $magic_len) {
372cb964	125	like ($@, "/^Magic number checking on storable $what failed/",
b8778c7c NC	126	"Should croak with magic number warning");
b8778c7c NC	127	} else {
372cb964	128	is ($@, "", "Should not set \$\@");
b8778c7c NC	129	}
	130	}
	131	}
	132
	133	sub test_corrupt {
	134	my ($data, $sub, $what, $name) = @_;
	135
	136	my $clone = &$sub($data);
372cb964 NC	137	is (defined ($clone), '', "$name $what should fail");
372cb964 NC	138	like ($@, $what, $name);
b8778c7c NC	139	}
	140
	141	sub test_things {
	142	my ($contents, $sub, $what, $isnetwork) = @_;
	143	my $isfile = $what eq 'file';
	144	my $file_magic = $isfile ? length $file_magic_str : 0;
	145
	146	my $header = Storable::read_magic ($contents);
	147	test_header ($header, $isfile, $isnetwork);
	148
	149	# Test that if we re-write it, everything still works:
	150	my $clone = &$sub ($contents);
	151
372cb964	152	is ($@, "", "There should be no error");
b8778c7c NC	153
	154	test_hash ($clone);
	155
	156	# Now lets check the short version:
	157	test_truncated ($contents, $sub, $file_magic
	158	+ ($isnetwork ? $network_magic : $other_magic), $what);
	159
	160	my $copy;
	161	if ($isfile) {
	162	$copy = $contents;
	163	substr ($copy, 0, 4) = 'iron';
	164	test_corrupt ($copy, $sub, "/^File is not a perl storable/",
	165	"magic number");
	166	}
	167
	168	$copy = $contents;
530b72ba NC	169	# Needs to be more than 1, as we're already coding a spread of 1 minor version
	170	# number on writes (2.5, 2.4). May increase to 2 if we figure we can do 2.3
	171	# on 5.005_03 (No utf8).
	172	# 4 allows for a small safety margin
	173	# (Joke:
	174	# Question: What is the value of pi?
	175	# Mathematician answers "It's pi, isn't it"
	176	# Physicist answers "3.1, within experimental error"
	177	# Engineer answers "Well, allowing for a small safety margin, 18"
	178	# )
	179	my $minor4 = $header->{minor} + 4;
	180	substr ($copy, $file_magic + 1, 1) = chr $minor4;
e8189732 NC	181	{
	182	# Now by default newer minor version numbers are not a pain.
	183	$clone = &$sub($copy);
372cb964	184	is ($@, "", "by default no error on higher minor");
e8189732 NC	185	test_hash ($clone);
	186
	187	local $Storable::accept_future_minor = 0;
	188	test_corrupt ($copy, $sub,
	189	"/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/",
	190	"higher minor");
	191	}
b8778c7c NC	192
	193	$copy = $contents;
	194	my $major1 = $header->{major} + 1;
	195	substr ($copy, $file_magic, 1) = chr 2*$major1;
	196	test_corrupt ($copy, $sub,
530b72ba	197	"/^Storable binary image v$major1\.$header->{minor} more recent than I am \\(v$header->{major}\.$minor\\)/",
b8778c7c NC	198	"higher major");
	199
	200	# Continue messing with the previous copy
530b72ba	201	my $minor1 = $header->{minor} - 1;
b8778c7c NC	202	substr ($copy, $file_magic + 1, 1) = chr $minor1;
b8778c7c NC	203	test_corrupt ($copy, $sub,
530b72ba	204	"/^Storable binary image v$major1\.$minor1 more recent than I am \\(v$header->{major}\.$minor\\)/",
b8778c7c NC	205	"higher major, lower minor");
	206
	207	my $where;
	208	if (!$isnetwork) {
	209	# All these are omitted from the network order header.
	210	# I'm not sure if it's correct to omit the byte size stuff.
	211	$copy = $contents;
	212	substr ($copy, $file_magic + 3, length $header->{byteorder})
	213	= reverse $header->{byteorder};
	214
	215	test_corrupt ($copy, $sub, "/^Byte order is not compatible/",
	216	"byte order");
	217	$where = $file_magic + 3 + length $header->{byteorder};
	218	foreach (['intsize', "Integer"],
291cf09c	219	['longsize', "Long integer"],
a2307be4	220	['ptrsize', "Pointer"],
b8778c7c NC	221	['nvsize', "Double"]) {
	222	my ($key, $name) = @$_;
	223	$copy = $contents;
	224	substr ($copy, $where++, 1) = chr 0;
	225	test_corrupt ($copy, $sub, "/^$name size is not compatible/",
	226	"$name size");
	227	}
	228	} else {
	229	$where = $file_magic + $network_magic;
	230	}
	231
	232	# Just the header and a tag 255. As 26 is currently the highest tag, this
	233	# is "unexpected"
	234	$copy = substr ($contents, 0, $where) . chr 255;
	235
	236	test_corrupt ($copy, $sub,
	237	"/^Corrupted storable $what \\(binary v$header->{major}.$header->{minor}\\)/",
	238	"bogus tag");
e8189732 NC	239
	240	# Now drop the minor version number
	241	substr ($copy, $file_magic + 1, 1) = chr $minor1;
	242
	243	test_corrupt ($copy, $sub,
	244	"/^Corrupted storable $what \\(binary v$header->{major}.$minor1\\)/",
	245	"bogus tag, minor less 1");
	246	# Now increase the minor version number
	247	substr ($copy, $file_magic + 1, 1) = chr $minor4;
	248
	249	# local $Storable::DEBUGME = 1;
	250	# This is the delayed croak
	251	test_corrupt ($copy, $sub,
464b080a	252	"/^Storable binary image v$header->{major}.$minor4 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 26/",
e8189732 NC	253	"bogus tag, minor plus 4");
	254	# And check again that this croak is not delayed:
	255	{
	256	# local $Storable::DEBUGME = 1;
	257	local $Storable::accept_future_minor = 0;
	258	test_corrupt ($copy, $sub,
	259	"/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/",
	260	"higher minor");
	261	}
b8778c7c NC	262	}
	263
	264	sub slurp {
	265	my $file = shift;
	266	local (*FH, $/);
	267	open FH, "<$file" or die "Can't open '$file': $!";
	268	binmode FH;
	269	my $contents = <FH>;
	270	die "Can't read $file: $!" unless defined $contents;
	271	return $contents;
	272	}
	273
	274
	275	ok (defined store(\%hash, $file));
	276
9d80fab7	277	my $expected = 20 + length ($file_magic_str) + $other_magic + $fancy;
b8778c7c NC	278	my $length = -s $file;
	279
	280	die "Don't seem to have written file '$file' as I can't get its length: $!"
	281	unless defined $file;
	282
291cf09c	283	die "Expected file to be $expected bytes (sizeof long is $Config{longsize}) but it is $length"
b8778c7c NC	284	unless $length == $expected;
	285
	286	# Read the contents into memory:
	287	my $contents = slurp $file;
	288
	289	# Test the original direct from disk
	290	my $clone = retrieve $file;
	291	test_hash ($clone);
	292
	293	# Then test it.
	294	test_things($contents, \&store_and_retrieve, 'file');
	295
	296	# And now try almost everything again with a Storable string
	297	my $stored = freeze \%hash;
	298	test_things($stored, \&freeze_and_thaw, 'string');
	299
	300	# Network order.
	301	unlink $file or die "Can't unlink '$file': $!";
	302
	303	ok (defined nstore(\%hash, $file));
	304
9d80fab7	305	$expected = 20 + length ($file_magic_str) + $network_magic + $fancy;
b8778c7c NC	306	$length = -s $file;
	307
	308	die "Don't seem to have written file '$file' as I can't get its length: $!"
	309	unless defined $file;
	310
291cf09c	311	die "Expected file to be $expected bytes (sizeof long is $Config{longsize}) but it is $length"
b8778c7c NC	312	unless $length == $expected;
	313
	314	# Read the contents into memory:
	315	$contents = slurp $file;
	316
	317	# Test the original direct from disk
	318	$clone = retrieve $file;
	319	test_hash ($clone);
	320
	321	# Then test it.
	322	test_things($contents, \&store_and_retrieve, 'file', 1);
	323
	324	# And now try almost everything again with a Storable string
	325	$stored = nfreeze \%hash;
	326	test_things($stored, \&freeze_and_thaw, 'string', 1);
fcaa57e7 AMS	327
	328	# Test that the bug fixed by #20587 doesn't affect us under some older
	329	# Perl. AMS 20030901
	330	{
	331	chop(my $a = chr(0xDF).chr(256));
	332	my %a = (chr(0xDF) => 1);
	333	$a{$a}++;
	334	freeze \%a;
	335	# If we were built with -DDEBUGGING, the assert() should have killed
	336	# us, which will probably alert the user that something went wrong.
	337	ok(1);
	338	}