From: Nicholas Clark Date: Fri, 31 May 2002 00:02:22 +0000 (+0100) Subject: Storable compatibility with 64 bit 5.6.x X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee0f7aac1ecaadc3d1d4426e1767e2fd6044b164;p=p5sagit%2Fp5-mst-13.2.git Storable compatibility with 64 bit 5.6.x Message-ID: <20020530230221.GC296@Bagpuss.unfortu.net> p4raw-id: //depot/perl@16909 --- diff --git a/MANIFEST b/MANIFEST index 7b805c9..bc36b6f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -613,8 +613,10 @@ ext/Storable/t/downgrade.t See if Storable works ext/Storable/t/forgive.t See if Storable works ext/Storable/t/freeze.t See if Storable works ext/Storable/t/integer.t See if Storable works +ext/Storable/t/interwork56.t Test combatibility kludge for 64bit data under 5.6.x ext/Storable/t/lock.t See if Storable works -ext/Storable/t/make_downgrade.pl See if Storable works +ext/Storable/t/make_56_interwork.pl Make test data for interwork56.t +ext/Storable/t/make_downgrade.pl Make test data for downgrade.t ext/Storable/t/malice.t See if Storable copes with corrupt files ext/Storable/t/overload.t See if Storable works ext/Storable/t/recurse.t See if Storable works diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog index c281ab9..1480983 100644 --- a/ext/Storable/ChangeLog +++ b/ext/Storable/ChangeLog @@ -1,3 +1,36 @@ +Thu May 30 20:31:08 BST 2002 Nicholas Clark + +. Description: + + Version 2.03 Header changes on 5.6.x on Unix where IV is long long + + 5.6.x introduced the ability to have IVs as long long. However, + Configure still defined BYTEORDER based on the size of a long. + Storable uses the BYTEORDER value as part of the header, but doesn't + explicity store sizeof(IV) anywhere in the header. Hence on 5.6.x + built with IV as long long on a platform that uses Configure (ie most + things except VMS and Windows) headers are identical for the different + IV sizes, despite the files containing some fields based on sizeof(IV) + + 5.8.0 is consistent; all platforms have BYTEORDER in config.h based on + sizeof(IV) rather than sizeof(long). This means that the value of + BYTEORDER will change from (say) 4321 to 87654321 between 5.6.1 and + 5.8.0 built with the same options to Configure on the same machine. + This means that the Storable header will differ, and the two versions + will wrongly thing that they are incompatible. + + For the benefit of long term consistency, Storable now implements the + 5.8.0 BYTEORDER policy on 5.6.x. This means that 2.03 onwards default + to be incompatible with 2.02 and earlier (ie the large 1.0.x installed + base) on the same 5.6.x perl. + + To allow interworking, a new variable $Storable::interwork_56_64bit + is introduced. It defaults to false. Set it to true to read and + write old format files. Don't use it unless you have existing + stored data written with 5.6.x that you couldn't otherwise read, + or you need to interwork with a machine running older Storable on + a 5.6.x with long long IVs. ie you probably don't need to use it. + Sat May 25 22:38:39 BST 2002 Nicholas Clark Version 2.02 diff --git a/ext/Storable/MANIFEST b/ext/Storable/MANIFEST index b4c9ae5..6c75149 100644 --- a/ext/Storable/MANIFEST +++ b/ext/Storable/MANIFEST @@ -13,8 +13,10 @@ t/downgrade.t See if Storable works t/forgive.t See if Storable works t/freeze.t See if Storable works t/integer.t For "use integer" testing +t/interwork56.t Test combatibility kludge for 64bit data under 5.6.x t/lock.t See if Storable works -t/make_downgrade.pl See if Storable works +t/make_56_interwork.pl Make test data for interwork56.t +t/make_downgrade.pl Make test data for downgrade.t t/malice.t See if Storable copes with corrupt files t/overload.t See if Storable works t/recurse.t See if Storable works diff --git a/ext/Storable/Makefile.PL b/ext/Storable/Makefile.PL index 90bd52e..4845d53 100644 --- a/ext/Storable/Makefile.PL +++ b/ext/Storable/Makefile.PL @@ -18,3 +18,23 @@ WriteMakefile( VERSION_FROM => 'Storable.pm', dist => { SUFFIX => 'gz', COMPRESS => 'gzip -f' }, ); + +my $ivtype = $Config{ivtype}; + +# I don't know if the VMS folks ever supported long long on 5.6.x +if ($ivtype and $ivtype eq 'long long' and $^O !~ /^MSWin/) { + print <<'EOM'; + +You appear to have a perl configured to use 64 bit integers in its scalar +variables. If you have existing data written with an earlier version of +Storable which this version of Storable refuses to load with a + + Byte order is not compatible + +error, then please read the section "64 bit data in perl 5.6.0 and 5.6.1" +in the Storable documentation for instructions on how to read your data. + +(You can find the documentation at the end of Storable.pm in POD format) + +EOM +} diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm index 5e86f11..3ea8794 100644 --- a/ext/Storable/Storable.pm +++ b/ext/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter DynaLoader); use AutoLoader; use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.02'; +$VERSION = '2.03'; *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... # @@ -846,6 +846,69 @@ C is a blunt tool. There is no facility either to return B strings as utf8 sequences, or to attempt to convert utf8 data back to 8 bit and C if the conversion fails. +Prior to Storable 2.01, no distinction was made between signed and +unsigned integers on storing. By default Storable prefers to store a +scalars string representation (if it has one) so this would only cause +problems when storing large unsigned integers that had never been coverted +to string or floating point. In other words values that had been generated +by integer operations such as logic ops and then not used in any string or +arithmetic context before storing. + +=head2 64 bit data in perl 5.6.0 and 5.6.1 + +This section only applies to you if you have existing data written out +by Storable 2.02 or earlier on perl 5.6.0 or 5.6.1 on Unix or Linux which +has been configured with 64 bit integer support (not the default) +If you got a precompiled perl, rather than running Configure to build +your own perl from source, then it almost certainly does not affect you, +and you can stop reading now (unless you're curious). If you're using perl +on Windows it does not affect you. + +Storable writes a file header which contains the sizes of various C +language types for the C compiler that built Storable (when not writing in +network order), and will refuse to load files written by a Storable not +on the same (or compatible) architecture. This check and a check on +machine byteorder is needed because the size of various fields in the file +are given by the sizes of the C language types, and so files written on +different architectures are incompatible. This is done for increased speed. +(When writing in network order, all fields are written out as standard +lengths, which allows full interworking, but takes longer to read and write) + +Perl 5.6.x introduced the ability to optional configure the perl interpreter +to use C's C type to allow scalars to store 64 bit integers on 32 +bit systems. However, due to the way the Perl configuration system +generated the C configuration files on non-Windows platforms, and the way +Storable generates its header, nothing in the Storable file header reflected +whether the perl writing was using 32 or 64 bit integers, despite the fact +that Storable was storing some data differently in the file. Hence Storable +running on perl with 64 bit integers will read the header from a file +written by a 32 bit perl, not realise that the data is actually in a subtly +incompatible format, and then go horribly wrong (possibly crashing) if it +encountered a stored integer. This is a design failure. + +Storable has now been changed to write out and read in a file header with +information about the size of integers. It's impossible to detect whether +an old file being read in was written with 32 or 64 bit integers (they have +the same header) so it's impossible to automatically switch to a correct +backwards compatibility mode. Hence this Storable defaults to the new, +correct behaviour. + +What this means is that if you have data written by Storable 1.x running +on perl 5.6.0 or 5.6.1 configured with 64 bit integers on Unix or Linux +then by default this Storable will refuse to read it, giving the error +I. If you have such data then you you +should set C<$Storable::interwork_56_64bit> to a true value to make this +Storable read and write files with the old header. You should also +migrate your data, or any older perl you are communicating with, to this +current version of Storable. + +If you don't have data written with specific configuration of perl described +above, then you do not and should not do anything. Don't set the flag - +not only will Storable on an identically configured perl refuse to load them, +but Storable a differently configured perl will load them believing them +to be correct for it, and then may well fail or crash part way through +reading them. + =head1 CREDITS Thank you to (in chronological order): diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 0315b38..6436d0d 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -701,14 +701,49 @@ static const char magicstr[] = "pst0"; /* Used as a magic number */ #define MAGICSTR_BYTES 'p','s','t','0' #define OLDMAGICSTR_BYTES 'p','e','r','l','-','s','t','o','r','e' +/* 5.6.x introduced the ability to have IVs as long long. + However, Configure still defined BYTEORDER based on the size of a long. + Storable uses the BYTEORDER value as part of the header, but doesn't + explicity store sizeof(IV) anywhere in the header. Hence on 5.6.x built + with IV as long long on a platform that uses Configure (ie most things + except VMS and Windows) headers are identical for the different IV sizes, + despite the files containing some fields based on sizeof(IV) + Erk. Broken-ness. + 5.8 is consistent - the following redifinition kludge is only needed on + 5.6.x, but the interwork is needed on 5.8 while data survives in files + with the 5.6 header. + +*/ + +#if defined (IVSIZE) && (IVSIZE == 8) && (LONGSIZE == 4) +#ifndef NO_56_INTERWORK_KLUDGE +#define USE_56_INTERWORK_KLUDGE +#endif +#if BYTEORDER == 0x1234 +#undef BYTEORDER +#define BYTEORDER 0x12345678 +#else +#if BYTEORDER == 0x4321 +#undef BYTEORDER +#define BYTEORDER 0x87654321 +#endif +#endif +#endif + #if BYTEORDER == 0x1234 #define BYTEORDER_BYTES '1','2','3','4' #else #if BYTEORDER == 0x12345678 #define BYTEORDER_BYTES '1','2','3','4','5','6','7','8' +#ifdef USE_56_INTERWORK_KLUDGE +#define BYTEORDER_BYTES_56 '1','2','3','4' +#endif #else #if BYTEORDER == 0x87654321 #define BYTEORDER_BYTES '8','7','6','5','4','3','2','1' +#ifdef USE_56_INTERWORK_KLUDGE +#define BYTEORDER_BYTES_56 '4','3','2','1' +#endif #else #if BYTEORDER == 0x4321 #define BYTEORDER_BYTES '4','3','2','1' @@ -720,6 +755,9 @@ static const char magicstr[] = "pst0"; /* Used as a magic number */ #endif static const char byteorderstr[] = {BYTEORDER_BYTES, 0}; +#ifdef USE_56_INTERWORK_KLUDGE +static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; +#endif #define STORABLE_BIN_MAJOR 2 /* Binary major "version" */ #define STORABLE_BIN_MINOR 5 /* Binary minor "version" */ @@ -3170,6 +3208,20 @@ static int magic_write(stcxt_t *cxt) (unsigned char) sizeof(char *), (unsigned char) sizeof(NV) }; +#ifdef USE_56_INTERWORK_KLUDGE + static const unsigned char file_header_56[] = { + MAGICSTR_BYTES, + (STORABLE_BIN_MAJOR << 1) | 0, + STORABLE_BIN_WRITE_MINOR, + /* sizeof the array includes the 0 byte at the end: */ + (char) sizeof (byteorderstr_56) - 1, + BYTEORDER_BYTES_56, + (unsigned char) sizeof(int), + (unsigned char) sizeof(long), + (unsigned char) sizeof(char *), + (unsigned char) sizeof(NV) + }; +#endif const unsigned char *header; SSize_t length; @@ -3179,8 +3231,16 @@ static int magic_write(stcxt_t *cxt) header = network_file_header; length = sizeof (network_file_header); } else { - header = file_header; - length = sizeof (file_header); +#ifdef USE_56_INTERWORK_KLUDGE + if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) { + header = file_header_56; + length = sizeof (file_header_56); + } else +#endif + { + header = file_header; + length = sizeof (file_header); + } } if (!cxt->fio) { @@ -5039,8 +5099,19 @@ static SV *magic_check(stcxt_t *cxt) TRACEME(("byte order '%.*s' %d", c, buf, c)); - if ((c != (sizeof (byteorderstr) - 1)) || memNE(buf, byteorderstr, c)) - CROAK(("Byte order is not compatible")); +#ifdef USE_56_INTERWORK_KLUDGE + /* No point in caching this in the context as we only need it once per + retrieve, and we need to recheck it each read. */ + if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) { + if ((c != (sizeof (byteorderstr_56) - 1)) + || memNE(buf, byteorderstr_56, c)) + CROAK(("Byte order is not compatible")); + } else +#endif + { + if ((c != (sizeof (byteorderstr) - 1)) || memNE(buf, byteorderstr, c)) + CROAK(("Byte order is not compatible")); + } current = buf + c; @@ -5545,6 +5616,9 @@ BOOT: /* Only disable the used only once warning if we are in debugging mode. */ gv_fetchpv("Storable::DEBUGME", GV_ADDMULTI, SVt_PV); #endif +#ifdef USE_56_INTERWORK_KLUDGE + gv_fetchpv("Storable::interwork_56_64bit", GV_ADDMULTI, SVt_PV); +#endif int pstore(f,obj) diff --git a/ext/Storable/t/interwork56.t b/ext/Storable/t/interwork56.t new file mode 100644 index 0000000..33fcd82 --- /dev/null +++ b/ext/Storable/t/interwork56.t @@ -0,0 +1,189 @@ +#!./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. + +sub BEGIN { + if ($ENV{PERL_CORE}){ + chdir('t') if -d 't'; + @INC = ('.', '../lib'); + } else { + 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; + } + unless ($Config{ivsize} and $Config{ivsize} > $Config{longsize}) { + print "1..0 # Skip: Your IVs are no larger than your longs\n"; + exit 0; + } +} + +use Storable qw(freeze thaw); +use strict; +use Test::More tests=>30; + +use vars qw(%tests); + +{ + local $/ = "\n\nend\n"; + while () { + next unless /\S/s; + unless (/begin ([0-7]{3}) ([^\n]*)\n(.*)$/s) { + s/\n.*//s; + warn "Dodgy data in section starting '$_'"; + next; + } + next unless oct $1 == ord 'A'; # Skip ASCII on EBCDIC, and vice versa + my $data = unpack 'u', $3; + $tests{$2} = $data; + } +} + +# perl makes easy things easy, and hard things possible: +my $test = freeze \'Hell'; + +my $header = Storable::read_magic ($test); + +is ($header->{byteorder}, $Config{byteorder}, + "header's byteorder and Config.pm's should agree"); + +my $result = eval {thaw $test}; +isa_ok ($result, 'SCALAR', "Check thawing test data"); +is ($@, '', "causes no errors"); +is ($$result, 'Hell', 'and gives the expected data'); + +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: +# +# byteorder '$Config{byteorder}' +# sizeof(int) $$header{intsize} +# sizeof(long) $$header{longsize} +# sizeof(char *) $$header{ptrsize} +# sizeof(NV) $$header{nvsize} + +# If you have Storable 1.x built with perl 5.6.x on this platform, please +# 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"); + like ($@, qr/Byte order is not compatible/, + "because the header byte order strings differ"); + local $Storable::interwork_56_64bit = 1; + $result = eval {thaw $real_thing}; + isa_ok ($result, 'ARRAY', "With flag should now thaw"); + 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 + my $value = (~0 ^ (~0 >> 1) ^ 2); + + is (@$result, 4, "4 elements in array"); + like ($$result[0], + qr/^This file was written with [0-9.]+ on perl [0-9.]+\z/, + "1st element"); + is ($$result[1], "$kingdom was correct", "2nd element"); + cmp_ok ($$result[2] ^ $value, '==', 0, "3rd element") or + printf "# expected %#X, got %#X\n", $value, $$result[2]; + is ($$result[3], "The End", "4th element"); +} + +$result = eval {thaw $test}; +isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); +is ($@, '', " causes no errors"); +is ($$result, 'Hell', " and gives the expected data"); + +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"); +like ($@, qr/Byte order is not compatible/, + "because the header byte order strings differ"); + +$result = eval {thaw $test}; +isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); +is ($@, '', " causes no errors"); +is ($$result, 'Hell', " and gives the expected data"); + +{ + local $Storable::interwork_56_64bit = 1; + + $result = eval {thaw $test_kludge}; + isa_ok ($result, 'SCALAR', "should be able to thaw kludge data"); + is ($@, '', "with no errors"); + is ($$result, 'Heck', "and gives expected data"); + + $result = eval {thaw $test}; + is ($result, undef, "But now can't thaw real data"); + like ($@, qr/Byte order is not compatible/, + "because the header byte order strings differ"); +} + +# All together now: +$result = eval {thaw $test}; +isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); +is ($@, '', " causes no errors"); +is ($$result, 'Hell', " and gives the expected data"); + +__END__ +# A whole run of 1.1.14 freeze data, uuencoded. The "mode bits" are the octal +# value of 'A', the "file name" is the test name. Use make_56_interwork.pl +# 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 +M!`0$,3(S-`0$!`@"!`````HQ5&AI> 1) ^ 2), + "The End"]; + +my $ivsize = $Config{ivsize} || $Config{longsize}; + +my $storesize = unpack 'xxC', $frozen; +my $storebyteorder = unpack "xxxA$storesize", $frozen; + +if ($Config{byteorder} eq $storebyteorder) { + my $ivtype = $Config{ivtype} || 'long'; + print <<"EOM"; +You only need to run this generator program where Config.pm's byteorder string +is not the same length as the size of IVs. + +This length difference should only happen on perl 5.6.x configured with IVs as +long long on Unix, OS/2 or any platform that runs the Configure stript (ie not +MS Windows) + +This is perl $], sizeof(long) is $Config{longsize}, IVs are '$ivtype', sizeof(IV) is $ivsize, +byteorder is '$Config{byteorder}', Storable $Storable::VERSION writes a byteorder of '$storebyteorder' +EOM + exit; # Grr ' +} + +my ($i, $l, $p, $n) = unpack "xxxx${storesize}CCCC", $frozen; + +print <<"EOM"; +# byteorder '$storebyteorder' +# sizeof(int) $i +# sizeof(long) $l +# sizeof(char *) $p +# sizeof(NV) $n +EOM + +my $uu = pack 'u', $frozen; + +printf "begin %3o $kingdom,$i,$l,$p,$n\n", ord 'A'; +print $uu; +print "\nend\n\n"; diff --git a/ext/Storable/t/malice.t b/ext/Storable/t/malice.t index 639fc36..8ae4032 100644 --- a/ext/Storable/t/malice.t +++ b/ext/Storable/t/malice.t @@ -32,21 +32,6 @@ use vars qw($file_magic_str $other_magic $network_magic $byteorder $byteorder = $Config{byteorder}; -if ($] < 5.007003 && $] >= 5.006 && $^O ne 'MSWin32' - && $Config{longsize} != $Config{ivsize}) { - # 5.6.x, not on Windows, built with IVs as long long - # config.h and Config.sh differ in their idea of the value of byteorder - # Storable's header is written out using C (hence config.h), but we're - # testing with perl - if ($byteorder eq '12345678') { - $byteorder = '1234'; - } elsif ($byteorder eq '87654321') { - $byteorder = '4321'; - } else { - die "I don't recognise Your byteorder: '$byteorder'"; - } -} - $file_magic_str = 'pst0'; $other_magic = 7 + length $byteorder; $network_magic = 2;