This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix the misplaced warnings and failing tests caused by the precision
authorNicholas Clark <nick@ccl4.org>
Wed, 23 Jan 2008 09:18:41 +0000 (09:18 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 23 Jan 2008 09:18:41 +0000 (09:18 +0000)
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

19 files changed:
Configure
Cross/config.sh-arm-linux
NetWare/config.wc
Porting/Glossary
Porting/config.sh
Porting/config_H
config_h.SH
configure.com
epoc/config.sh
plan9/config_sh.sample
sv.c
symbian/config.sh
t/op/inc.t
uconfig.sh
win32/config.bc
win32/config.ce
win32/config.gc
win32/config.vc
win32/config.vc64

index fb29114..5b21d0e 100755 (executable)
--- 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'
index ec46890..ee44d11 100644 (file)
@@ -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"'
index 942226c..092a821 100644 (file)
@@ -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"'
index a457ed5..42d75a1 100644 (file)
@@ -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.
index b20a656..eb9ab01 100644 (file)
@@ -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"'
index 2540a14..f74dc67 100644 (file)
  *     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.
 #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
index 16160e5..47604e9 100644 (file)
@@ -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
index ee0f1cc..501ade3 100644 (file)
@@ -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 + "'"
index bd1a20f..75d4260 100644 (file)
@@ -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'
index 9ce1038..8907af7 100644 (file)
@@ -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 (file)
--- 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;
        }
     }
index e53ed93..59925bf 100644 (file)
@@ -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'
index 95b0698..f722336 100755 (executable)
@@ -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, @$_);
        }
     }
 
index 4fa6a0a..3f9813c 100755 (executable)
@@ -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'
index ec883a9..a2aa979 100644 (file)
@@ -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"'
index 00dabcf..b722e6a 100644 (file)
@@ -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"'
index 5e62678..4c932cd 100644 (file)
@@ -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"'
index 3c58cdc..3f9be6d 100644 (file)
@@ -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"'
index 6680911..c881439 100644 (file)
@@ -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"'