Change 32990 by [EMAIL PROTECTED] on 2008/01/17 14:23:48
warn if ++ or -- are unable to change the value because it's beyond
the limit of representation in NVs, using a new warnings category
"imprecision".
Affected files ...
... //depot/perl/lib/warnings.pm#46 edit
... //depot/perl/pod/perldiag.pod#494 edit
... //depot/perl/pod/perllexwarn.pod#32 edit
... //depot/perl/sv.c#1486 edit
... //depot/perl/t/op/inc.t#13 edit
... //depot/perl/warnings.h#38 edit
... //depot/perl/warnings.pl#62 edit
Differences ...
==== //depot/perl/lib/warnings.pm#46 (text+w) ====
Index: perl/lib/warnings.pm
--- perl/lib/warnings.pm#45~32090~ 2007-10-10 01:17:07.000000000 -0700
+++ perl/lib/warnings.pm 2008-01-17 06:23:48.000000000 -0800
@@ -188,10 +188,14 @@
'untie' => 86,
'utf8' => 88,
'void' => 90,
+
+ # Warnings Categories added in Perl 5.011
+
+ 'imprecision' => 92,
);
our %Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05",
# [0..45]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15",
# [0..46]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00",
# [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [6]
@@ -202,6 +206,7 @@
'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [7]
'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [3]
'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [4]
+ 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10",
# [46]
'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00",
# [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00",
# [24]
'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [5..11]
@@ -240,7 +245,7 @@
);
our %DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a",
# [0..45]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a",
# [0..46]
'ambiguous' =>
"\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00",
# [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [6]
@@ -251,6 +256,7 @@
'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [7]
'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [3]
'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [4]
+ 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20",
# [46]
'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00",
# [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00",
# [24]
'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00",
# [5..11]
@@ -289,7 +295,7 @@
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 92 ;
+$LAST_BIT = 94 ;
$BYTES = 12 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
==== //depot/perl/pod/perldiag.pod#494 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#493~32954~ 2008-01-11 05:55:07.000000000 -0800
+++ perl/pod/perldiag.pod 2008-01-17 06:23:48.000000000 -0800
@@ -2258,6 +2258,15 @@
(F) There is currently a limit on the length of string which lookbehind can
handle. This restriction may be eased in a future release.
+=item Lost precision when %s %f by 1
+
+(W) The value you attempted to increment or decrement by one is too large
+for the underlying floating point representation to store accurately,
+hence the target of C<++> or C<--> is unchanged. Perl issues this warning
+because it has already switched from integers to floating point when values
+are too large for integers, and now even floating point is insufficient.
+You may wish to switch to using L<Math::BigInt> explicitly.
+
=item lstat() on filehandle %s
(W io) You tried to do an lstat on a filehandle. What did you mean
==== //depot/perl/pod/perllexwarn.pod#32 (text) ====
Index: perl/pod/perllexwarn.pod
--- perl/pod/perllexwarn.pod#31~31592~ 2007-07-11 22:51:35.000000000 -0700
+++ perl/pod/perllexwarn.pod 2008-01-17 06:23:48.000000000 -0800
@@ -236,6 +236,8 @@
| |
| +- unopened
|
+ +- imprecision
+ |
+- misc
|
+- numeric
==== //depot/perl/sv.c#1486 (text) ====
Index: perl/sv.c
--- perl/sv.c#1485~32982~ 2008-01-16 04:12:10.000000000 -0800
+++ perl/sv.c 2008-01-17 06:23:48.000000000 -0800
@@ -6794,8 +6794,15 @@
return;
}
if (flags & SVp_NOK) {
+ const NV was = SvNVX(sv);
+ const NV now = was + 1.0;
+ if (now - was != 1.0 && ckWARN(WARN_IMPRECISION)) {
+ Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
+ "Lost precision when incrementing %" NVff " by 1",
+ was);
+ }
(void)SvNOK_only(sv);
- SvNV_set(sv, SvNVX(sv) + 1.0);
+ SvNV_set(sv, now);
return;
}
@@ -6939,8 +6946,10 @@
SvUV_set(sv, SvUVX(sv) - 1);
}
} else {
- if (SvIVX(sv) == IV_MIN)
- sv_setnv(sv, (NV)IV_MIN - 1.0);
+ if (SvIVX(sv) == IV_MIN) {
+ sv_setnv(sv, (NV)IV_MIN);
+ goto oops_its_num;
+ }
else {
(void)SvIOK_only(sv);
SvIV_set(sv, SvIVX(sv) - 1);
@@ -6949,9 +6958,19 @@
return;
}
if (flags & SVp_NOK) {
- SvNV_set(sv, SvNVX(sv) - 1.0);
- (void)SvNOK_only(sv);
- return;
+ oops_its_num:
+ {
+ const NV was = SvNVX(sv);
+ const NV now = was - 1.0;
+ if (now - was != -1.0 && ckWARN(WARN_IMPRECISION)) {
+ Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
+ "Lost precision when decrementing %" NVff " by 1",
+ was);
+ }
+ (void)SvNOK_only(sv);
+ SvNV_set(sv, now);
+ return;
+ }
}
if (!(flags & SVp_POK)) {
if ((flags & SVTYPEMASK) < SVt_PVIV)
==== //depot/perl/t/op/inc.t#13 (xtext) ====
Index: perl/t/op/inc.t
--- perl/t/op/inc.t#12~25763~ 2005-10-15 14:35:29.000000000 -0700
+++ perl/t/op/inc.t 2008-01-17 06:23:48.000000000 -0800
@@ -2,7 +2,7 @@
# use strict;
-print "1..34\n";
+print "1..50\n";
my $test = 1;
@@ -194,3 +194,68 @@
$x--;
ok ($x == 0, "(void) i_postdec");
}
+
+# I'm sure that there's an IBM format with a 48 bit mantissa
+# IEEE doubles have a 53 bit mantissa
+# 80 bit long doubles have a 64 bit mantissa
+# sparcs have a 112 bit mantissa for their long doubles. Just to be awkward :-)
+
+sub check_some_code {
+ my ($start, $warn, $action, $description) = @_;
+ my $warn_line = ($warn ? 'use' : 'no') . " warnings 'imprecision';";
+ my @warnings;
+ local $SIG{__WARN__} = sub {push @warnings, "@_"};
+
+ print "# checking $action under $warn_line\n";
+ my $code = <<"EOC";
+$warn_line
+my \$i = \$start;
+for(0 .. 3) {
+ my \$a = $action;
+}
+1;
+EOC
+ eval $code or die "# [EMAIL PROTECTED]";
+
+ if ($warn) {
+ unless (ok (scalar @warnings == 2, scalar @warnings)) {
+ print STDERR "# $_" foreach @warnings;
+ }
+ foreach (@warnings) {
+ unless (ok (/Lost precision when incrementing \d+/, $_)) {
+ print STDERR "# $_"
+ }
+ }
+ } else {
+ unless (ok (scalar @warnings == 0)) {
+ print STDERR "# @$_" foreach @warnings;
+ }
+ }
+}
+
+my $found;
+for my $n (47..113) {
+ my $power_of_2 = 2**$n;
+ my $plus_1 = $power_of_2 + 1;
+ next if $plus_1 != $power_of_2;
+ print "# Testing for 2**$n ($power_of_2) which overflows the mantissa\n";
+ # doing int here means that for NV > IV on the first go we're in the
+ # IV upgrade to NV case, and the second go we're in the NV already case.
+ my $start = int($power_of_2 - 2);
+ my $check = $power_of_2 - 2;
+ die "Something wrong with our rounding assumptions: $check vs $start"
+ unless $start == $check;
+
+ foreach my $warn (0, 1) {
+ foreach (['++$i', 'pre-inc'], ['$i++', 'post-inc']) {
+ check_some_code($start, $warn, @$_);
+ }
+ foreach (['--$i', 'pre-dec'], ['$i--', 'post-dec']) {
+ check_some_code(-$start, $warn, @$_);
+ }
+ }
+
+ $found = 1;
+ last;
+}
+die "Could not find a value which overflows the mantissa" unless $found;
==== //depot/perl/warnings.h#38 (text+w) ====
Index: perl/warnings.h
--- perl/warnings.h#37~31386~ 2007-06-15 01:55:38.000000000 -0700
+++ perl/warnings.h 2008-01-17 06:23:48.000000000 -0800
@@ -76,6 +76,10 @@
#define WARN_UTF8 44
#define WARN_VOID 45
+/* Warnings Categories added in Perl 5.011 */
+
+#define WARN_IMPRECISION 46
+
#define WARNsize 12
#define WARN_ALLstring
"\125\125\125\125\125\125\125\125\125\125\125\125"
#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0"
==== //depot/perl/warnings.pl#62 (text) ====
Index: perl/warnings.pl
--- perl/warnings.pl#61~32090~ 2007-10-10 01:17:07.000000000 -0700
+++ perl/warnings.pl 2008-01-17 06:23:48.000000000 -0800
@@ -61,6 +61,7 @@
'pack' => [ 5.008, DEFAULT_OFF],
'unpack' => [ 5.008, DEFAULT_OFF],
'threads' => [ 5.008, DEFAULT_OFF],
+ 'imprecision' => [ 5.011, DEFAULT_OFF],
#'default' => [ 5.008, DEFAULT_ON ],
}],
End of Patch.
