From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 23 Jan 2008 09:18:41 +0000 (+0000)
Subject: Fix the misplaced warnings and failing tests caused by the precision
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b68c599a1231c4d11ec0b0a667ce0c407c357eab;p=p5sagit%2Fp5-mst-13.2.git

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

p4raw-id: //depot/perl@33049
---

diff --git a/Configure b/Configure
index fb29114..5b21d0e 100755
--- a/Configure
+++ b/Configure
@@ -1058,6 +1058,7 @@ i8type=''
 ivsize=''
 ivtype=''
 nv_preserves_uv_bits=''
+nv_overflows_integers_at=''
 nvsize=''
 nvtype=''
 u16size=''
@@ -15468,6 +15469,89 @@ case "$nv_preserves_uv_bits" in
 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 @@ nroff='$nroff'
 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'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index ec46890..ee44d11 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -808,6 +808,7 @@ nvEUformat='"E"'
 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"'
diff --git a/NetWare/config.wc b/NetWare/config.wc
index 942226c..092a821 100644
--- a/NetWare/config.wc
+++ b/NetWare/config.wc
@@ -784,6 +784,7 @@ nvEUformat='"E"'
 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"'
diff --git a/Porting/Glossary b/Porting/Glossary
index a457ed5..42d75a1 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -3799,6 +3799,11 @@ nv_preserves_uv_bits (perlxv.U):
 	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.
diff --git a/Porting/config.sh b/Porting/config.sh
index b20a656..eb9ab01 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -824,6 +824,7 @@ nroff='nroff'
 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"'
diff --git a/Porting/config_H b/Porting/config_H
index 2540a14..f74dc67 100644
--- a/Porting/config_H
+++ b/Porting/config_H
@@ -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
diff --git a/config_h.SH b/config_h.SH
index 16160e5..47604e9 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -4300,6 +4300,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *	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 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
 #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
diff --git a/configure.com b/configure.com
index ee0f1cc..501ade3 100644
--- a/configure.com
+++ b/configure.com
@@ -5939,6 +5939,8 @@ $ WC "d_nanosleep='" + d_nanosleep + "'"
 $ 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 + "'"
diff --git a/epoc/config.sh b/epoc/config.sh
index bd1a20f..75d4260 100644
--- a/epoc/config.sh
+++ b/epoc/config.sh
@@ -970,6 +970,7 @@ d_strtoll='undef'
 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'
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 9ce1038..8907af7 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -789,6 +789,7 @@ nvEUformat='"E"'
 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"'
diff --git a/sv.c b/sv.c
index 0618a8a..a59af0d 100644
--- a/sv.c
+++ b/sv.c
@@ -6802,14 +6802,14 @@ Perl_sv_inc(pTHX_ register SV *sv)
     }
     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 @@ Perl_sv_dec(pTHX_ register SV *sv)
     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;
 	}
     }
diff --git a/symbian/config.sh b/symbian/config.sh
index e53ed93..59925bf 100644
--- a/symbian/config.sh
+++ b/symbian/config.sh
@@ -661,6 +661,7 @@ nv_preserves_uv_bits='0'
 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'
diff --git a/t/op/inc.t b/t/op/inc.t
index 95b0698..f722336 100755
--- a/t/op/inc.t
+++ b/t/op/inc.t
@@ -233,25 +233,36 @@ EOC
     }
 }
 
+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, @$_);
 	}
     }
 
diff --git a/uconfig.sh b/uconfig.sh
index 4fa6a0a..3f9813c 100755
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -269,6 +269,7 @@ d_nl_langinfo='undef'
 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'
diff --git a/win32/config.bc b/win32/config.bc
index ec883a9..a2aa979 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -802,6 +802,7 @@ nvEUformat='"E"'
 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"'
diff --git a/win32/config.ce b/win32/config.ce
index 00dabcf..b722e6a 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -775,6 +775,7 @@ nm_so_opt=''
 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"'
diff --git a/win32/config.gc b/win32/config.gc
index 5e62678..4c932cd 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -802,6 +802,7 @@ nvEUformat='"E"'
 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"'
diff --git a/win32/config.vc b/win32/config.vc
index 3c58cdc..3f9be6d 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -802,6 +802,7 @@ nvEUformat='"E"'
 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"'
diff --git a/win32/config.vc64 b/win32/config.vc64
index 6680911..c881439 100644
--- a/win32/config.vc64
+++ b/win32/config.vc64
@@ -802,6 +802,7 @@ nvEUformat='"E"'
 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"'