#!./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 ought to keep this test easily backwards compatible to 5.004, so no
# qr//;
# This test checks whether the kludge to interwork with 5.6 Storables compiled
# on Unix systems with IV as long long works.
chdir('t') if -d 't';
} else {
}
print "1..0 # Skip: Storable was not built\n";
exit 0;
}
print "1..0 # Skip: Your IVs are no larger than your longs\n";
exit 0;
}
}
use strict;
{
local $/ = "\n\nend\n";
next unless /\S/s;
s/\n.*//s;
next;
}
}
}
# perl makes easy things easy, and hard things possible:
my $header = Storable::read_magic ($test);
is ($header->{byteorder}, $Config{byteorder},
my $result = eval {thaw $test};
is ($@, '', "causes no errors");
my $kingdom = $Config{byteorder} =~ /23/ ? "Lillput" : "Belfuscu";
my $name = join ',', $kingdom, @$header{qw(intsize longsize ptrsize nvsize)};
SKIP: {
my $real_thing = $tests{$name};
if (!defined $real_thing) {
print << "EOM";
# No test data for Storable 1.x for:
#
# sizeof(int) $$header{intsize}
# sizeof(long) $$header{longsize}
# sizeof(char *) $$header{ptrsize}
# sizeof(NV) $$header{nvsize}
# make_56_interwork.pl to generate test data, and append the test data to
# this test.
# You may find that make_56_interwork.pl reports that your platform has no
# interworking problems, in which case you need do nothing.
EOM
skip "# No 1.x test file", 9;
}
my $result = eval {thaw $real_thing};
is ($result, undef, "By default should not be able to thaw");
"because the header byte order strings differ");
local $Storable::interwork_56_64bit = 1;
$result = eval {thaw $real_thing};
is ($@, '', "with no errors");
# However, as the file is written with Storable pre 2.01, it's a known
# bug that large (positive) UVs become IVs
"1st element");
}
my $test_kludge;
{
local $Storable::interwork_56_64bit = 1;
$test_kludge = freeze \'Heck';
}
my $header_kludge = Storable::read_magic ($test_kludge);
cmp_ok (length ($header_kludge->{byteorder}), '==', $Config{longsize},
"With 5.6 interwork kludge byteorder string should be same size as long"
);
$result = eval {thaw $test_kludge};
is ($result, undef, "By default should not be able to thaw");
"because the header byte order strings differ");
$result = eval {thaw $test};
is ($@, '', " causes no errors");
{
local $Storable::interwork_56_64bit = 1;
$result = eval {thaw $test_kludge};
is ($@, '', "with no errors");
$result = eval {thaw $test};
}
# All together now:
__END__
# with a copy of Storable 1.X generate these.
# byteorder '1234'
# sizeof(int) 4
# sizeof(long) 4
# sizeof(char *) 4
# sizeof(NV) 8
begin 101 Lillput,4,4,4,8
end
# byteorder '4321'
# sizeof(int) 4
# sizeof(long) 4
# sizeof(char *) 4
# sizeof(NV) 8
M!`0$-#,R,00$!`@"````!`HQ5&AI<R!F:6QE('=A<R!W<FET=&5N('=I=&@@
1@`````````(*!U1H92!%;F0`
end
# byteorder '1234'
# sizeof(int) 4
# sizeof(long) 4
# sizeof(char *) 4
# sizeof(NV) 12
end