Change 16437 by jhi@alpha on 2002/05/06 22:38:26
Subject: Re: perl@16433
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Tue, 7 May 2002 00:21:46 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/Storable/Storable.pm#24 edit
.... //depot/perl/ext/Storable/Storable.xs#47 edit
.... //depot/perl/ext/Storable/t/malice.t#8 edit
Differences ...
==== //depot/perl/ext/Storable/Storable.pm#24 (text) ====
Index: perl/ext/Storable/Storable.pm
--- perl/ext/Storable/Storable.pm#23~16337~ Thu May 2 01:21:42 2002
+++ perl/ext/Storable/Storable.pm Mon May 6 15:38:26 2002
@@ -102,6 +102,7 @@
# By default restricted hashes are downgraded on earlier perls.
$Storable::downgrade_restricted = 1;
+$Storable::accept_future_minor = 1;
bootstrap Storable;
1;
__END__
@@ -589,6 +590,25 @@
placeholder keys and leaving the keys and all values unlocked. To make
Storable C<croak()> instead, set C<$Storable::downgrade_restricted> to
a false value. To restore the default set it back to some C<TRUE> value.
+
+=item files from future versions of Storable
+
+Earlier versions of Storable would immediately croak if they encountered
+a file with a higher internal version number than the reading Storable
+knew about. Internal version numbers are increased each time new data
+types (such as restricted hashes) are added to the vocabulary of the file
+format. This meant that a newer Storable module had no way of writing a
+file readable by an older Storable, even if writer didn't store newer
+data types.
+
+This version of Storable will defer croaking until it encounters a data
+type in the file that it does not recognize. This means that it will
+continue to read files generated by newer Storable modules which are careful
+in what they write out, making it easier to upgrade Storable modules in a
+mixed environment.
+
+The old behaviour of immediate croaking can be re-instated by setting
+C<$Storable::accept_future_minor> to false.
=back
==== //depot/perl/ext/Storable/Storable.xs#47 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#46~16415~ Sun May 5 08:51:01 2002
+++ perl/ext/Storable/Storable.xs Mon May 6 15:38:26 2002
@@ -59,7 +59,7 @@
#include <XSUB.h>
#ifndef NETWARE
-#if 1
+#if 0
#define DEBUGME /* Debug mode, turns assertions on as well */
#define DASSERT /* Assertion mode */
#endif
@@ -339,6 +339,7 @@
#ifndef HAS_UTF8_ALL
int use_bytes; /* whether to bytes-ify utf8 */
#endif
+ int accept_future_minor; /* croak immediately on future minor versions? */
int s_dirty; /* context is dirty due to CROAK() -- can be cleaned */
int membuf_ro; /* true means membuf is read-only and msaved is rw */
struct extendable keybuf; /* for hash key retrieval */
@@ -1204,6 +1205,9 @@
sv_free((SV *) hook_seen);
}
+ cxt->forgive_me = -1; /* Fetched from perl if needed */
+ cxt->canonical = -1; /* Idem */
+
reset_context(cxt);
}
@@ -1249,6 +1253,7 @@
#ifndef HAS_UTF8_ALL
cxt->use_bytes = -1; /* Fetched from perl if needed */
#endif
+ cxt->accept_future_minor = -1; /* Fetched from perl if needed */
}
/*
@@ -1290,6 +1295,14 @@
sv_free((SV *) hseen); /* optional HV, for backward compat. */
}
+#ifndef HAS_RESTRICTED_HASHES
+ cxt->derestrict = -1; /* Fetched from perl if needed */
+#endif
+#ifndef HAS_UTF8_ALL
+ cxt->use_bytes = -1; /* Fetched from perl if needed */
+#endif
+ cxt->accept_future_minor = -1; /* Fetched from perl if needed */
+
reset_context(cxt);
}
@@ -4891,12 +4904,26 @@
(version_major == STORABLE_BIN_MAJOR &&
version_minor > STORABLE_BIN_MINOR)
) {
- TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR,
- STORABLE_BIN_MINOR));
-
+ int croak_now = 1;
+ TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR,
+ STORABLE_BIN_MINOR));
+
+ if (version_major == STORABLE_BIN_MAJOR) {
+ TRACEME(("cxt->accept_future_minor is %d",
+ cxt->accept_future_minor));
+ if (cxt->accept_future_minor < 0)
+ cxt->accept_future_minor
+ = (SvTRUE(perl_get_sv("Storable::accept_future_minor",
+ TRUE))
+ ? 1 : 0);
+ if (cxt->accept_future_minor == 1)
+ croak_now = 0; /* Don't croak yet. */
+ }
+ if (croak_now) {
CROAK(("Storable binary image v%d.%d more recent than I am (v%d.%d)",
- version_major, version_minor,
- STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR));
+ version_major, version_minor,
+ STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR));
+ }
}
/*
@@ -5034,7 +5061,19 @@
TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv)));
SvREFCNT_inc(sv); /* One more reference to this same sv */
return sv; /* The SV pointer where object was
retrieved */
- }
+ } else if (type >= SX_ERROR && cxt->ver_minor > STORABLE_BIN_MINOR) {
+ if (cxt->accept_future_minor < 0)
+ cxt->accept_future_minor
+ = (SvTRUE(perl_get_sv("Storable::accept_future_minor",
+ TRUE))
+ ? 1 : 0);
+ if (cxt->accept_future_minor == 1) {
+ CROAK(("Storable binary image v%d.%d contains data of type %d. "
+ "This Storable is v%d.%d and can only handle data types up to
+%d",
+ cxt->ver_major, cxt->ver_minor, type,
+ STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR, SX_ERROR - 1));
+ }
+ }
first_time: /* Will disappear when support for old format is dropped */
==== //depot/perl/ext/Storable/t/malice.t#8 (text) ====
Index: perl/ext/Storable/t/malice.t
--- perl/ext/Storable/t/malice.t#7~16340~ Thu May 2 05:44:23 2002
+++ perl/ext/Storable/t/malice.t Mon May 6 15:38:26 2002
@@ -48,7 +48,7 @@
# 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 => 334 + length($Config{byteorder}) * 4 + $fancy * 8;
+ plan tests => 378 + length($Config{byteorder}) * 4 + $fancy * 8;
}
use Storable qw (store retrieve freeze thaw nstore nfreeze);
@@ -174,9 +174,17 @@
# )
my $minor4 = $header->{minor} + 4;
substr ($copy, $file_magic + 1, 1) = chr $minor4;
- test_corrupt ($copy, $sub,
- "/^Storable binary image v$header->{major}\.$minor4 more recent than
I am \\(v$header->{major}\.$minor\\)/",
- "higher minor");
+ {
+ # Now by default newer minor version numbers are not a pain.
+ $clone = &$sub($copy);
+ ok ($@, "", "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;
@@ -224,6 +232,29 @@
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}.$header->{minor} and can only handle
+data types up to 25/",
+ "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 {
End of Patch.
