Change 18008 by [EMAIL PROTECTED] on 2002/10/12 14:38:19
Subject: [PATCH] Storable 2.06 (was Re: Bug in ext/Storable/t/integer.t)
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Mon, 7 Oct 2002 23:35:34 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/Storable/ChangeLog#21 edit
.... //depot/perl/ext/Storable/Makefile.PL#15 edit
.... //depot/perl/ext/Storable/README#6 edit
.... //depot/perl/ext/Storable/Storable.pm#42 edit
.... //depot/perl/ext/Storable/Storable.xs#62 edit
.... //depot/perl/ext/Storable/t/downgrade.t#10 edit
.... //depot/perl/ext/Storable/t/forgive.t#8 edit
.... //depot/perl/ext/Storable/t/integer.t#7 edit
.... //depot/perl/ext/Storable/t/malice.t#18 edit
.... //depot/perl/ext/Storable/t/restrict.t#7 edit
Differences ...
==== //depot/perl/ext/Storable/ChangeLog#21 (text) ====
Index: perl/ext/Storable/ChangeLog
--- perl/ext/Storable/ChangeLog#20~17970~ Wed Oct 2 19:21:15 2002
+++ perl/ext/Storable/ChangeLog Sat Oct 12 07:38:19 2002
@@ -1,3 +1,23 @@
+Mon Oct 7 21:56:38 BST 2002 Nicholas Clark <[EMAIL PROTECTED]>
+
+ Version 2.06
+
+ Remove qr// from t/downgrade.t so that it will run on 5.004
+ Mention $File::Spec::VERSION a second time in t/forgive.t so that it
+ runs without warnings in 5.004 (this may be a 5.00405 bug I'm working
+ round)
+ Fix t/integer.t initialisation to actually generate 64 bits of 9c
+ Fix comparison tests to use eval to get around 64 bit IV conversion
+ issues on 5.6.x, following my t/integer.t ^ precedence bug found by
+ Rafael Garcia-Suarez
+ Alter t/malice.t to work with Test/More.pm in t/, and skip individual
+ subtests that use $Config{ptrsize}, so that the rest of the test can
+ now be run with 5.004
+ Change t/malice.t and the error message in check_magic in Storable.xs
+ from "Pointer integer size" to "Pointer size"
+ Remove prerequisite of Test::More from Makefile.PL
+ Ship Test::Builder, Test::Simple and Test::More in t
+
Thu Oct 3 08:57:22 IST 2002 Abhijit Menon-Sen <[EMAIL PROTECTED]>
Version 2.05
==== //depot/perl/ext/Storable/Makefile.PL#15 (text) ====
Index: perl/ext/Storable/Makefile.PL
--- perl/ext/Storable/Makefile.PL#14~16953~ Fri May 31 20:20:52 2002
+++ perl/ext/Storable/Makefile.PL Sat Oct 12 07:38:19 2002
@@ -12,7 +12,8 @@
NAME => 'Storable',
DISTNAME => "Storable",
MAN3PODS => {},
- PREREQ_PM => { 'Test::More' => '0.41' },
+# We now ship this in t/
+# PREREQ_PM => { 'Test::More' => '0.41' },
INSTALLDIRS => 'perl',
VERSION_FROM => 'Storable.pm',
dist => { SUFFIX => 'gz', COMPRESS => 'gzip -f' },
==== //depot/perl/ext/Storable/README#6 (text) ====
Index: perl/ext/Storable/README
--- perl/ext/Storable/README#5~16850~ Tue May 28 23:48:19 2002
+++ perl/ext/Storable/README Sat Oct 12 07:38:19 2002
@@ -1,4 +1,4 @@
- Storable 1.015
+ Storable 2.06
Copyright (c) 1995-2000, Raphael Manfredi
Copyright (c) 2001,2002, Larry Wall
==== //depot/perl/ext/Storable/Storable.pm#42 (text) ====
Index: perl/ext/Storable/Storable.pm
--- perl/ext/Storable/Storable.pm#41~17971~ Thu Oct 3 04:03:41 2002
+++ perl/ext/Storable/Storable.pm Sat Oct 12 07:38:19 2002
@@ -21,7 +21,7 @@
use AutoLoader;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.05';
+$VERSION = '2.06';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
@@ -360,6 +360,9 @@
$@ = $da;
return $self;
}
+
+1;
+__END__
=head1 NAME
==== //depot/perl/ext/Storable/Storable.xs#62 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#61~17785~ Mon Aug 26 08:18:41 2002
+++ perl/ext/Storable/Storable.xs Sat Oct 12 07:38:19 2002
@@ -5348,7 +5348,7 @@
/* sizeof(char *) */
if ((int) *current != sizeof(char *))
- CROAK(("Pointer integer size is not compatible"));
+ CROAK(("Pointer size is not compatible"));
if (use_NV_size) {
/* sizeof(NV) */
@@ -5642,7 +5642,22 @@
if (!sv) {
TRACEME(("retrieve ERROR"));
+#if (PATCHLEVEL <= 4)
+ /* perl 5.00405 seems to screw up at this point with an
+ 'attempt to modify a read only value' error reported in the
+ eval { $self = pretrieve(*FILE) } in _retrieve.
+ I can't see what the cause of this error is, but I suspect a
+ bug in 5.004, as it seems to be capable of issuing spurious
+ errors or core dumping with matches on $@. I'm not going to
+ spend time on what could be a fruitless search for the cause,
+ so here's a bodge. If you're running 5.004 and don't like
+ this inefficiency, either upgrade to a newer perl, or you are
+ welcome to find the problem and send in a patch.
+ */
+ return newSV(0);
+#else
return &PL_sv_undef; /* Something went wrong, return undef
*/
+#endif
}
TRACEME(("retrieve got %s(0x%"UVxf")",
==== //depot/perl/ext/Storable/t/downgrade.t#10 (text) ====
Index: perl/ext/Storable/t/downgrade.t
--- perl/ext/Storable/t/downgrade.t#9~17971~ Thu Oct 3 04:03:41 2002
+++ perl/ext/Storable/t/downgrade.t Sat Oct 12 07:38:19 2002
@@ -9,13 +9,6 @@
# I ought to keep this test easily backwards compatible to 5.004, so no
# qr//;
-BEGIN {
- if ($] < 5.005) {
- print "1..0 # Skip: usage of qr//\n";
- exit 0;
- }
-}
-
# This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features
# are encountered.
@@ -67,8 +60,8 @@
plan tests => 67;
}
-$UTF8_CROAK = qr/^Cannot retrieve UTF8 data in non-UTF8 perl/;
-$RESTRICTED_CROAK = qr/^Cannot retrieve restricted hash/;
+$UTF8_CROAK = "/^Cannot retrieve UTF8 data in non-UTF8 perl/";
+$RESTRICTED_CROAK = "/^Cannot retrieve restricted hash/";
my %tests;
{
@@ -128,11 +121,11 @@
my @keys = keys %$hash;
my ($key, $value) = each %$hash;
eval {$hash->{$key} = reverse $value};
- like( $@, qr/^Modification of a read-only value attempted/,
+ like( $@, "/^Modification of a read-only value attempted/",
'trying to change a locked key' );
is ($hash->{$key}, $value, "hash should not change?");
eval {$hash->{use} = 'perl'};
- like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/,
+ like( $@, "/^Attempt to access disallowed key 'use' in a restricted hash/",
'trying to add another key' );
ok (eq_array([keys %$hash], \@keys), "Still the same keys?");
}
@@ -146,7 +139,7 @@
'trying to change a restricted key' );
is ($hash->{$key}, reverse ($value), "hash should change");
eval {$hash->{use} = 'perl'};
- like( $@, qr/^Attempt to access disallowed key 'use' in a restricted hash/,
+ like( $@, "/^Attempt to access disallowed key 'use' in a restricted hash/",
'trying to add another key' );
ok (eq_array([keys %$hash], \@keys), "Still the same keys?");
}
==== //depot/perl/ext/Storable/t/forgive.t#8 (text) ====
Index: perl/ext/Storable/t/forgive.t
--- perl/ext/Storable/t/forgive.t#7~17971~ Thu Oct 3 04:03:41 2002
+++ perl/ext/Storable/t/forgive.t Sat Oct 12 07:38:19 2002
@@ -29,6 +29,9 @@
if (eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) {
print "1..0 # Skip: File::Spec 0.8 needed\n";
exit 0;
+ # Mention $File::Spec::VERSION again, as 5.00503's harness seems to have
+ # warnings on.
+ exit $File::Spec::VERSION;
}
print "1..8\n";
==== //depot/perl/ext/Storable/t/integer.t#7 (text) ====
Index: perl/ext/Storable/t/integer.t
--- perl/ext/Storable/t/integer.t#6~17974~ Thu Oct 3 14:00:50 2002
+++ perl/ext/Storable/t/integer.t Sat Oct 12 07:38:19 2002
@@ -37,10 +37,10 @@
# use integer.
my $max_iv_p1 = $max_uv ^ ($max_uv >> 1);
my $lots_of_9C = do {
- my $temp = sprintf "%X", ~0;
- $temp =~ s/FF/9C/g;
+ my $temp = sprintf "%#x", ~0;
+ $temp =~ s/ff/9c/g;
local $^W;
- hex $temp;
+ eval $temp;
};
my $max_iv = ~0 >> 1;
@@ -122,7 +122,7 @@
foreach my $number (@numbers) {
# as $number is an alias into @numbers, we don't want any side effects of
# conversion macros affecting later runs, so pass a copy to Storable:
- my $copy1 = my $copy0 = $number;
+ my $copy1 = my $copy2 = my $copy0 = $number;
my $copy_s = &$sub (\$copy0);
if (is (ref $copy_s, "SCALAR", "got back a scalar ref?")) {
# Test inside use integer to see if the bit pattern is identical
@@ -148,19 +148,28 @@
# $eq = && (($copy_s1 <=> 0) == ($copy1 <=> 0));
# Split this into 2 tests, to cater for 5.005_03
- my $bit = ok (($copy_s1 ^ $copy1) == 0, "$process $copy1 (bitpattern)");
+ # Aargh. Even this doesn't work because 5.6.x sends values with (same
+ # number of decimal digits as ~0 + 1) via atof. So ^ is getting strings
+ # cast to doubles cast to integers. And that truncates low order bits.
+ # my $bit = ok (($copy_s1 ^ $copy1) == 0, "$process $copy1 (bitpattern)");
+
+ # Oh well; at least the parser gets it right. :-)
+ my $copy_s3 = eval $copy_s1;
+ die "Was supposed to have number $copy_s3, got error $@"
+ unless defined $copy_s3;
+ my $bit = ok (($copy_s3 ^ $copy1) == 0, "$process $copy1 (bitpattern)");
# This is sick. 5.005_03 survives without the IV/UV flag, and somehow
# gets it right, providing you don't have side effects of conversion.
# local $TODO;
# $TODO = "pre 5.6 doesn't have flag to distinguish IV/UV"
# if $[ < 5.005_56 and $copy1 > $max_iv;
- my $sign = ok (($copy_s2 <=> 0) == ($copy1 <=> 0),
+ my $sign = ok (($copy_s2 <=> 0) == ($copy2 <=> 0),
"$process $copy1 (sign)");
unless ($bit and $sign) {
printf "# Passed in %s (%#x, %i)\n# got back '%s' (%#x, %i)\n",
$copy1, $copy1, $copy1, $copy_s1, $copy_s1, $copy_s1;
- # use Devel::Peek; Dump $copy_s1; Dump $$copy_s;
+ # use Devel::Peek; Dump $number; Dump $copy1; Dump $copy_s1;
}
# unless ($bit) { use Devel::Peek; Dump $copy_s1; Dump $$copy_s; }
} else {
==== //depot/perl/ext/Storable/t/malice.t#18 (text) ====
Index: perl/ext/Storable/t/malice.t
--- perl/ext/Storable/t/malice.t#17~17971~ Thu Oct 3 04:03:41 2002
+++ perl/ext/Storable/t/malice.t Sat Oct 12 07:38:19 2002
@@ -17,16 +17,15 @@
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;
}
- if ($] < 5.005) {
- print "1..0 # Skip: Config{ptrsize} not defined\n";
- exit 0;
- }
}
use strict;
@@ -88,7 +87,11 @@
is ($header->{byteorder}, $byteorder, "byte order");
is ($header->{intsize}, $Config{intsize}, "int size");
is ($header->{longsize}, $Config{longsize}, "long size");
- is ($header->{ptrsize}, $Config{ptrsize}, "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.
}
@@ -115,6 +118,7 @@
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) {
@@ -213,7 +217,7 @@
$where = $file_magic + 3 + length $header->{byteorder};
foreach (['intsize', "Integer"],
['longsize', "Long integer"],
- ['ptrsize', "Pointer integer"],
+ ['ptrsize', "Pointer"],
['nvsize', "Double"]) {
my ($key, $name) = @$_;
$copy = $contents;
==== //depot/perl/ext/Storable/t/restrict.t#7 (text) ====
Index: perl/ext/Storable/t/restrict.t
--- perl/ext/Storable/t/restrict.t#6~16953~ Fri May 31 20:20:52 2002
+++ perl/ext/Storable/t/restrict.t Sat Oct 12 07:38:19 2002
@@ -16,9 +16,14 @@
exit 0;
}
} else {
- unless (eval "require Hash::Util") {
- if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/) {
- print "1..0 # Skip: No Hash::Util\n";
+ if ($[ < 5.005) {
+ print "1..0 # Skip: No Hash::Util pre 5.005\n";
+ exit 0;
+ # And doing this seems on 5.004 seems to create bogus warnings about
+ # unitialized variables, or coredumps in Perl_pp_padsv
+ } elsif (!eval "require Hash::Util") {
+ if ($@ =~ /Can\'t locate Hash\/Util\.pm in \@INC/s) {
+ print "1..0 # Skip: No Hash::Util:\n";
exit 0;
} else {
die;
End of Patch.
