In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8a0689d1232c652a3b90b947eb2626ea6054aceb?hp=d8330edcbfd4edd9185ac6da6710e7079304d40b>
- Log ----------------------------------------------------------------- commit 8a0689d1232c652a3b90b947eb2626ea6054aceb Author: Nicholas Clark <[email protected]> Date: Thu Dec 9 15:42:44 2010 +0000 Storable's t/malice.t now needs to use a minor version >4 ahead for testing. The "safety margin" of 4 has been used up, now that Storable 2.25 can read v2.8 files, but only writes out v2.4 on 5.004. All tests now pass on 5.004 (albeit with a bunch of warnings about ambiguous use of barewords, which are no longer warnings). Also, update $Test::Builder::Level to make diagnosing failing tests easier. M dist/Storable/t/malice.t commit 5e12106ffbc3a0186a034389bf81f563093d6a09 Author: Nicholas Clark <[email protected]> Date: Thu Dec 9 15:41:37 2010 +0000 Refactor Storable::read_magic to avoid 4 arg substr. This makes it fractionally shorter, and restores all compatibility with 5.004 M dist/Storable/Storable.pm ----------------------------------------------------------------------- Summary of changes: dist/Storable/Storable.pm | 25 ++++++++++++------------- dist/Storable/t/malice.t | 14 ++++++++------ 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index e762a3b..8368928 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -151,14 +151,14 @@ sub read_magic { $net_order = 0; } else { - $net_order = ord(substr($buf, 0, 1, "")); - my $major = $net_order >> 1; + $buf =~ s/(.)//s; + my $major = (ord $1) >> 1; return undef if $major > 4; # sanity (assuming we never go that high) $info{major} = $major; - $net_order &= 0x01; + $net_order = (ord $1) & 0x01; if ($major > 1) { - return undef unless length($buf); - my $minor = ord(substr($buf, 0, 1, "")); + return undef unless $buf =~ s/(.)//s; + my $minor = ord $1; $info{minor} = $minor; $info{version} = "$major.$minor"; $info{version_nv} = sprintf "%d.%03d", $major, $minor; @@ -171,17 +171,16 @@ sub read_magic { $info{netorder} = $net_order; unless ($net_order) { - return undef unless length($buf); - my $len = ord(substr($buf, 0, 1, "")); + return undef unless $buf =~ s/(.)//s; + my $len = ord $1; return undef unless length($buf) >= $len; return undef unless $len == 4 || $len == 8; # sanity - $info{byteorder} = substr($buf, 0, $len, ""); - $info{intsize} = ord(substr($buf, 0, 1, "")); - $info{longsize} = ord(substr($buf, 0, 1, "")); - $info{ptrsize} = ord(substr($buf, 0, 1, "")); + @info{qw(byteorder intsize longsize ptrsize)} + = unpack "a${len}CCC", $buf; + (substr $buf, 0, $len + 3) = ''; if ($info{version_nv} >= 2.002) { - return undef unless length($buf); - $info{nvsize} = ord(substr($buf, 0, 1, "")); + return undef unless $buf =~ s/(.)//s; + $info{nvsize} = ord $1; } } $info{hdrsize} = $buflen - length($buf); diff --git a/dist/Storable/t/malice.t b/dist/Storable/t/malice.t index 6da6909..f656398 100644 --- a/dist/Storable/t/malice.t +++ b/dist/Storable/t/malice.t @@ -110,6 +110,7 @@ sub test_corrupt { my ($data, $sub, $what, $name) = @_; my $clone = &$sub($data); + local $Test::Builder::Level = $Test::Builder::Level + 1; is (defined ($clone), '', "$name $what should fail"); like ($@, $what, $name); } @@ -146,14 +147,15 @@ sub test_things { # 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 + # Which we've now exhausted given that Storable 2.25 is writing 2.8 # (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; + my $minor6 = $header->{minor} + 6; + substr ($copy, $file_magic + 1, 1) = chr $minor6; { # Now by default newer minor version numbers are not a pain. $clone = &$sub($copy); @@ -162,7 +164,7 @@ sub test_things { 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\\)/", + "/^Storable binary image v$header->{major}\.$minor6 more recent than I am \\(v$header->{major}\.$minor\\)/", "higher minor"); } @@ -220,19 +222,19 @@ sub test_things { "/^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; + substr ($copy, $file_magic + 1, 1) = chr $minor6; # 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 28/", + "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 28/", "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\\)/", + "/^Storable binary image v$header->{major}\.$minor6 more recent than I am \\(v$header->{major}\.$minor\\)/", "higher minor"); } } -- Perl5 Master Repository
