Change 33049 by [EMAIL PROTECTED] on 2008/01/23 09:18:41
Fix the misplaced warnings and failing tests caused by the precision
loss warning on ++ and -- by moving the check to Configure time,
creating a new config.sh variable nv_overflows_integers_at which
contains an constant expression for the value of the NV which can't
be incremented by 1.0
Affected files ...
... //depot/perl/Configure#682 edit
... //depot/perl/Cross/config.sh-arm-linux#26 edit
... //depot/perl/NetWare/config.wc#40 edit
... //depot/perl/Porting/Glossary#186 edit
... //depot/perl/Porting/config.sh#172 edit
... //depot/perl/Porting/config_H#171 edit
... //depot/perl/config_h.SH#341 edit
... //depot/perl/configure.com#276 edit
... //depot/perl/epoc/config.sh#102 edit
... //depot/perl/plan9/config_sh.sample#19 edit
... //depot/perl/sv.c#1491 edit
... //depot/perl/symbian/config.sh#25 edit
... //depot/perl/t/op/inc.t#14 edit
... //depot/perl/uconfig.sh#82 edit
... //depot/perl/win32/config.bc#177 edit
... //depot/perl/win32/config.ce#12 edit
... //depot/perl/win32/config.gc#175 edit
... //depot/perl/win32/config.vc#184 edit
... //depot/perl/win32/config.vc64#54 edit
Differences ...
==== //depot/perl/Configure#682 (xtext) ====
Index: perl/Configure
--- perl/Configure#681~33038~ 2008-01-22 08:52:32.000000000 -0800
+++ perl/Configure 2008-01-23 01:18:41.000000000 -0800
@@ -1058,6 +1058,7 @@
ivsize=''
ivtype=''
nv_preserves_uv_bits=''
+nv_overflows_integers_at=''
nvsize=''
nvtype=''
u16size=''
@@ -15468,6 +15469,89 @@
esac
$rm_try
+$echo "Checking to find the largest integer value your NVs can hold..." >&4
+: volatile so that the compiler has to store it out to memory.
+if test X"$d_volatile" = X"$define"; then
+ volatile=volatile
+fi
+$cat <<EOP >try.c
+#include <stdio.h>
+
+typedef $nvtype NV;
+
+int
+main() {
+ NV value = 2;
+ int count = 1;
+
+ while(count < 256) {
+ $volatile NV up = value + 1.0;
+ $volatile NV negated = -value;
+ $volatile NV down = negated - 1.0;
+ $volatile NV got_up = up - value;
+ int up_good = got_up == 1.0;
+ int got_down = down - negated;
+ int down_good = got_down == -1.0;
+
+ if (down_good != up_good) {
+ fprintf(stderr,
+ "Inconsistency - up %d %f; down %d %f; for 2**%d (%.20f)\n",
+ up_good, (double) got_up, down_good, (double) got_down,
+ count, (double) value);
+ return 1;
+ }
+ if (!up_good) {
+ while (1) {
+ if (count > 8) {
+ count -= 8;
+ fputs("256.0", stdout);
+ } else {
+ count--;
+ fputs("2.0", stdout);
+ }
+ if (!count) {
+ puts("");
+ return 0;
+ }
+ fputs("*", stdout);
+ }
+ }
+ value *= 2;
+ ++count;
+ }
+ fprintf(stderr, "Cannot overflow integer range, even at 2**%d (%.20f)\n",
+ count, (double) value);
+ return 1;
+}
+EOP
+set try
+
+nv_overflows_integers_at='0'
+if eval $compile; then
+ xxx="`$run ./try`"
+ case "$?" in
+ 0)
+ case "$xxx" in
+ 2*) cat >&4 <<EOM
+The largest integer your NVs can preserve is equal to $xxx
+EOM
+ nv_overflows_integers_at="$xxx"
+ ;;
+ *) cat >&4 <<EOM
+Cannot determine the largest integer value your NVs can hold, unexpected output
+'$xxx'
+EOM
+ ;;
+ esac
+ ;;
+ *) cat >&4 <<EOM
+Cannot determine the largest integer value your NVs can hold
+EOM
+ ;;
+ esac
+fi
+$rm_try
+
$echo "Checking whether NV 0.0 is all bits zero in memory..." >&4
: volatile so that the compiler has to store it out to memory.
if test X"$d_volatile" = X"$define"; then
@@ -22420,6 +22504,7 @@
nvEUformat='$nvEUformat'
nvFUformat='$nvFUformat'
nvGUformat='$nvGUformat'
+nv_overflows_integers_at='$nv_overflows_integers_at'
nv_preserves_uv_bits='$nv_preserves_uv_bits'
nveformat='$nveformat'
nvfformat='$nvfformat'
==== //depot/perl/Cross/config.sh-arm-linux#26 (text) ====
Index: perl/Cross/config.sh-arm-linux
--- perl/Cross/config.sh-arm-linux#25~32953~ 2008-01-11 05:36:54.000000000
-0800
+++ perl/Cross/config.sh-arm-linux 2008-01-23 01:18:41.000000000 -0800
@@ -808,6 +808,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/NetWare/config.wc#40 (text) ====
Index: perl/NetWare/config.wc
--- perl/NetWare/config.wc#39~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/NetWare/config.wc 2008-01-23 01:18:41.000000000 -0800
@@ -784,6 +784,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/Porting/Glossary#186 (text) ====
Index: perl/Porting/Glossary
--- perl/Porting/Glossary#185~33038~ 2008-01-22 08:52:32.000000000 -0800
+++ perl/Porting/Glossary 2008-01-23 01:18:41.000000000 -0800
@@ -3799,6 +3799,11 @@
This variable indicates how many of bits type uvtype
a variable nvtype can preserve.
+nv_overflows_integers_at (perlxv.U):
+ This variable gives the largest integer value that NVs can hold
+ as a constant floating point expression.
+ If it could not be determined, it holds the value 0.
+
nveformat (perlxvf.U):
This variable contains the format string used for printing
a Perl NV using %e-ish floating point format.
==== //depot/perl/Porting/config.sh#172 (text) ====
Index: perl/Porting/config.sh
--- perl/Porting/config.sh#171~33047~ 2008-01-23 00:47:50.000000000 -0800
+++ perl/Porting/config.sh 2008-01-23 01:18:41.000000000 -0800
@@ -824,6 +824,7 @@
nvEUformat='"E"'
nvFUformat='"F"'
nvGUformat='"G"'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nv_preserves_uv_bits='53'
nveformat='"e"'
nvfformat='"f"'
==== //depot/perl/Porting/config_H#171 (text) ====
Index: perl/Porting/config_H
--- perl/Porting/config_H#170~33047~ 2008-01-23 00:47:50.000000000 -0800
+++ perl/Porting/config_H 2008-01-23 01:18:41.000000000 -0800
@@ -4271,6 +4271,12 @@
* This symbol contains the number of bits a variable of type NVTYPE
* can preserve of a variable of type UVTYPE.
*/
+/* NV_OVERFLOWS_INTEGERS_AT
+ * This symbol gives the largest integer value that NVs can hold. This
+ * value + 1.0 cannot be stored accurately. It is expressed as constant
+ * floating point expression to reduce the chance of decimale/binary
+ * conversion issues. If it can not be determined, the value 0 is given.
+ */
/* NV_ZERO_IS_ALLBITS_ZERO:
* This symbol, if defined, indicates that a variable of type NVTYPE
* stores 0.0 in memory as all bits zero.
@@ -4303,6 +4309,7 @@
#define NVSIZE 8 /**/
#undef NV_PRESERVES_UV
#define NV_PRESERVES_UV_BITS 53
+#define NV_OVERFLOWS_INTEGERS_AT
256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0
#define NV_ZERO_IS_ALLBITS_ZERO
#if UVSIZE == 8
# ifdef BYTEORDER
==== //depot/perl/config_h.SH#341 (text) ====
Index: perl/config_h.SH
--- perl/config_h.SH#340~33045~ 2008-01-22 23:51:53.000000000 -0800
+++ perl/config_h.SH 2008-01-23 01:18:41.000000000 -0800
@@ -4300,6 +4300,12 @@
* This symbol contains the number of bits a variable of type NVTYPE
* can preserve of a variable of type UVTYPE.
*/
+/* NV_OVERFLOWS_INTEGERS_AT
+ * This symbol gives the largest integer value that NVs can hold. This
+ * value + 1.0 cannot be stored accurately. It is expressed as constant
+ * floating point expression to reduce the chance of decimale/binary
+ * conversion issues. If it can not be determined, the value 0 is given.
+ */
/* NV_ZERO_IS_ALLBITS_ZERO:
* This symbol, if defined, indicates that a variable of type NVTYPE
* stores 0.0 in memory as all bits zero.
@@ -4332,6 +4338,7 @@
#define NVSIZE $nvsize /**/
#$d_nv_preserves_uv NV_PRESERVES_UV
#define NV_PRESERVES_UV_BITS $nv_preserves_uv_bits
+#define NV_OVERFLOWS_INTEGERS_AT $nv_overflows_integers_at
#$d_nv_zero_is_allbits_zero NV_ZERO_IS_ALLBITS_ZERO
#if UVSIZE == 8
# ifdef BYTEORDER
==== //depot/perl/configure.com#276 (text) ====
Index: perl/configure.com
--- perl/configure.com#275~32965~ 2008-01-11 17:07:54.000000000 -0800
+++ perl/configure.com 2008-01-23 01:18:41.000000000 -0800
@@ -5939,6 +5939,8 @@
$ WC "d_nice='define'"
$ WC "d_nl_langinfo='" + d_nl_langinfo + "'"
$ WC "d_nv_preserves_uv='" + d_nv_preserves_uv + "'"
+$! Pending integrating the probe test
+$ WC "nv_overflows_integers_at='0'"
$ WC "nv_preserves_uv_bits='" + nv_preserves_uv_bits + "'"
$ WC "d_nv_zero_is_allbits_zero='define'"
$ WC "d_off64_t='" + d_off64_t + "'"
==== //depot/perl/epoc/config.sh#102 (text) ====
Index: perl/epoc/config.sh
--- perl/epoc/config.sh#101~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/epoc/config.sh 2008-01-23 01:18:41.000000000 -0800
@@ -970,6 +970,7 @@
d_strtouq='undef'
d_nv_preserves_uv='define'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='0'
useithreads='undef'
inc_version_list=' '
inc_version_list_init='0'
==== //depot/perl/plan9/config_sh.sample#19 (text) ====
Index: perl/plan9/config_sh.sample
--- perl/plan9/config_sh.sample#18~32953~ 2008-01-11 05:36:54.000000000
-0800
+++ perl/plan9/config_sh.sample 2008-01-23 01:18:41.000000000 -0800
@@ -789,6 +789,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='31'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/sv.c#1491 (text) ====
Index: perl/sv.c
--- perl/sv.c#1490~33017~ 2008-01-20 13:50:31.000000000 -0800
+++ perl/sv.c 2008-01-23 01:18:41.000000000 -0800
@@ -6802,14 +6802,14 @@
}
if (flags & SVp_NOK) {
const NV was = SvNVX(sv);
- const NV now = was + 1.0;
- if (now - was != 1.0 && ckWARN(WARN_IMPRECISION)) {
+ if (NV_OVERFLOWS_INTEGERS_AT &&
+ was >= NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
"Lost precision when incrementing %" NVff " by 1",
was);
}
(void)SvNOK_only(sv);
- SvNV_set(sv, now);
+ SvNV_set(sv, was + 1.0);
return;
}
@@ -6968,14 +6968,14 @@
oops_its_num:
{
const NV was = SvNVX(sv);
- const NV now = was - 1.0;
- if (now - was != -1.0 && ckWARN(WARN_IMPRECISION)) {
+ if (NV_OVERFLOWS_INTEGERS_AT &&
+ was <= -NV_OVERFLOWS_INTEGERS_AT && 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);
+ SvNV_set(sv, was - 1.0);
return;
}
}
==== //depot/perl/symbian/config.sh#25 (text) ====
Index: perl/symbian/config.sh
--- perl/symbian/config.sh#24~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/symbian/config.sh 2008-01-23 01:18:41.000000000 -0800
@@ -661,6 +661,7 @@
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nvsize='8'
nvtype='double'
o_nonblock='O_NONBLOCK'
==== //depot/perl/t/op/inc.t#14 (xtext) ====
Index: perl/t/op/inc.t
--- perl/t/op/inc.t#13~32990~ 2008-01-17 06:23:48.000000000 -0800
+++ perl/t/op/inc.t 2008-01-23 01:18:41.000000000 -0800
@@ -233,25 +233,36 @@
}
}
+my $h_uv_max = 1 + (~0 >> 1);
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;
+ my ($start_p, $start_n);
+ if ($h_uv_max > $power_of_2 / 2) {
+ my $uv_max = 1 + 2 * (~0 >> 1);
+ # UV_MAX is 2**$something - 1, so subtract 1 to get the start value
+ $start_p = $uv_max - 1;
+ # whereas IV_MIN is -(2**$something), so subtract 2
+ $start_n = -$h_uv_max + 2;
+ print "# Mantissa overflows at 2**$n ($power_of_2)\n";
+ print "# But max UV ($uv_max) is greater so testing that\n";
+ } else {
+ print "# Testing 2**$n ($power_of_2) which overflows the mantissa\n";
+ $start_p = int($power_of_2 - 2);
+ $start_n = -$start_p;
+ my $check = $power_of_2 - 2;
+ die "Something wrong with our rounding assumptions: $check vs $start_p"
+ unless $start_p == $check;
+ }
foreach my $warn (0, 1) {
foreach (['++$i', 'pre-inc'], ['$i++', 'post-inc']) {
- check_some_code($start, $warn, @$_);
+ check_some_code($start_p, $warn, @$_);
}
foreach (['--$i', 'pre-dec'], ['$i--', 'post-dec']) {
- check_some_code(-$start, $warn, @$_);
+ check_some_code($start_n, $warn, @$_);
}
}
==== //depot/perl/uconfig.sh#82 (xtext) ====
Index: perl/uconfig.sh
--- perl/uconfig.sh#81~32981~ 2008-01-15 11:20:53.000000000 -0800
+++ perl/uconfig.sh 2008-01-23 01:18:41.000000000 -0800
@@ -269,6 +269,7 @@
d_nv_preserves_uv='undef'
d_nv_zero_is_allbits_zero='undef'
nv_preserves_uv_bits='0'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
d_off64_t='undef'
d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
==== //depot/perl/win32/config.bc#177 (text) ====
Index: perl/win32/config.bc
--- perl/win32/config.bc#176~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/win32/config.bc 2008-01-23 01:18:41.000000000 -0800
@@ -802,6 +802,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/win32/config.ce#12 (text) ====
Index: perl/win32/config.ce
--- perl/win32/config.ce#11~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/win32/config.ce 2008-01-23 01:18:41.000000000 -0800
@@ -775,6 +775,7 @@
nonxs_ext='Errno'
nroff=''
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/win32/config.gc#175 (text) ====
Index: perl/win32/config.gc
--- perl/win32/config.gc#174~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/win32/config.gc 2008-01-23 01:18:41.000000000 -0800
@@ -802,6 +802,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/win32/config.vc#184 (text) ====
Index: perl/win32/config.vc
--- perl/win32/config.vc#183~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/win32/config.vc 2008-01-23 01:18:41.000000000 -0800
@@ -802,6 +802,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='32'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
==== //depot/perl/win32/config.vc64#54 (text) ====
Index: perl/win32/config.vc64
--- perl/win32/config.vc64#53~32953~ 2008-01-11 05:36:54.000000000 -0800
+++ perl/win32/config.vc64 2008-01-23 01:18:41.000000000 -0800
@@ -802,6 +802,7 @@
nvFUformat='"F"'
nvGUformat='"G"'
nv_preserves_uv_bits='53'
+nv_overflows_integers_at='256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0'
nveformat='"e"'
nvfformat='"f"'
nvgformat='"g"'
End of Patch.
