Fix rounding errors in <, =, etc.

* etc/NEWS: Document this.
* src/bytecode.c (exec_byte_code):
* src/data.c (arithcompare):
Do not lose information when comparing floats to integers.
* test/src/data-tests.el (data-tests-=, data-tests-<)
(data-tests->, data-tests-<=, data-tests->=):
Test this.

4 files changed, 70 insertions, 41 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 5b5baff44e1..17353936e7f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -902,6 +902,11 @@ interpreting consecutive runs of numerical characters as numbers, and
 compares their numerical values.  According to this predicate,
 "foo2.png" is smaller than "foo12.png".
 
+---
+** Numeric comparisons no longer return incorrect answers due to
+internal rounding errors.  For example, (< most-positive-fixnum (+ 1.0
+most-positive-fixnum)) now correctly returns t on 64-bit hosts.
+
 +++
 ** The new function 'char-from-name' converts a Unicode name string
 to the corresponding character code.
diff --git a/src/bytecode.c b/src/bytecode.c
index 4414b077bb9..e781a87d16f 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -992,18 +992,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
         CASE (Beqlsign):
           {
             Lisp_Object v2 = POP, v1 = TOP;
-            CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
-            CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
-            bool equal;
             if (FLOATP (v1) || FLOATP (v2))
+              TOP = arithcompare (v1, v2, ARITH_EQUAL);
+            else
               {
-                double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1);
-                double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2);
-                equal = f1 == f2;
+                CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
+                CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
+                TOP = EQ (v1, v2) ? Qt : Qnil;
               }
-            else
-              equal = XINT (v1) == XINT (v2);
-            TOP = equal ? Qt : Qnil;
             NEXT;
           }
 
diff --git a/src/data.c b/src/data.c
index 32ec89871a8..88d86697e42 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2392,68 +2392,90 @@ bool-vector.  IDX starts at 0.  */)
 /* Arithmetic functions */
 
 Lisp_Object
-arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison)
+arithcompare (Lisp_Object num1, Lisp_Object num2,
+              enum Arith_Comparison comparison)
 {
-  double f1 = 0, f2 = 0;
-  bool floatp = 0;
+  double f1, f2;
+  EMACS_INT i1, i2;
+  bool fneq;
+  bool test;
 
   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
 
-  if (FLOATP (num1) || FLOATP (num2))
+  /* If either arg is floating point, set F1 and F2 to the 'double'
+     approximations of the two arguments.  Regardless, set I1 and I2
+     to integers that break ties if the floating point comparison is
+     either not done or reports equality.  */
+
+  if (FLOATP (num1))
+    {
+      f1 = XFLOAT_DATA (num1);
+      if (FLOATP (num2))
+        {
+          i1 = i2 = 0;
+          f2 = XFLOAT_DATA (num2);
+        }
+      else
+        i1 = f2 = i2 = XINT (num2);
+      fneq = f1 != f2;
+    }
+  else
     {
-      floatp = 1;
-      f1 = (FLOATP (num1)) ? XFLOAT_DATA (num1) : XINT (num1);
-      f2 = (FLOATP (num2)) ? XFLOAT_DATA (num2) : XINT (num2);
+      i1 = XINT (num1);
+      if (FLOATP (num2))
+        {
+          i2 = f1 = i1;
+          f2 = XFLOAT_DATA (num2);
+          fneq = f1 != f2;
+        }
+      else
+        {
+          i2 = XINT (num2);
+          fneq = false;
+        }
     }
 
   switch (comparison)
     {
     case ARITH_EQUAL:
-      if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
-        return Qt;
-      return Qnil;
+      test = !fneq && i1 == i2;
+      break;
 
     case ARITH_NOTEQUAL:
-      if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
-        return Qt;
-      return Qnil;
+      test = fneq || i1 != i2;
+      break;
 
     case ARITH_LESS:
-      if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
-        return Qt;
-      return Qnil;
+      test = fneq ? f1 < f2 : i1 < i2;
+      break;
 
     case ARITH_LESS_OR_EQUAL:
-      if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
-        return Qt;
-      return Qnil;
+      test = fneq ? f1 <= f2 : i1 <= i2;
+      break;
 
     case ARITH_GRTR:
-      if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
-        return Qt;
-      return Qnil;
+      test = fneq ? f1 > f2 : i1 > i2;
+      break;
 
     case ARITH_GRTR_OR_EQUAL:
-      if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
-        return Qt;
-      return Qnil;
+      test = fneq ? f1 >= f2 : i1 >= i2;
+      break;
 
     default:
-      emacs_abort ();
+      eassume (false);
     }
+
+  return test ? Qt : Qnil;
 }
 
 static Lisp_Object
 arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
                      enum Arith_Comparison comparison)
 {
-  ptrdiff_t argnum;
-  for (argnum = 1; argnum < nargs; ++argnum)
-    {
-      if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
-        return Qnil;
-    }
+  for (ptrdiff_t i = 1; i < nargs; i++)
+    if (NILP (arithcompare (args[i - 1], args[i], comparison)))
+      return Qnil;
   return Qt;
 }
 
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 2e4a6aa2e8a..d38760cdde6 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -29,6 +29,8 @@
   (should (= 1))
   (should (= 2 2))
   (should (= 9 9 9 9 9 9 9 9 9))
+  (should (= most-negative-fixnum (float most-negative-fixnum)))
+  (should-not (= most-positive-fixnum (+ 1.0 most-positive-fixnum)))
   (should-not (apply #'= '(3 8 3)))
   (should-error (= 9 9 'foo))
   ;; Short circuits before getting to bad arg
@@ -39,6 +41,7 @@
   (should (< 1))
   (should (< 2 3))
   (should (< -6 -1 0 2 3 4 8 9 999))
+  (should (< 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum)))
   (should-not (apply #'< '(3 8 3)))
   (should-error (< 9 10 'foo))
   ;; Short circuits before getting to bad arg
@@ -49,6 +52,7 @@
   (should (> 1))
   (should (> 3 2))
   (should (> 6 1 0 -2 -3 -4 -8 -9 -999))
+  (should (> (+ 1.0 most-positive-fixnum) most-positive-fixnum 0.5))
   (should-not (apply #'> '(3 8 3)))
   (should-error (> 9 8 'foo))
   ;; Short circuits before getting to bad arg
@@ -59,6 +63,7 @@
   (should (<= 1))
   (should (<= 2 3))
   (should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
+  (should (<= 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum)))
   (should-not (apply #'<= '(3 8 3 3)))
   (should-error (<= 9 10 'foo))
   ;; Short circuits before getting to bad arg
@@ -69,6 +74,7 @@
   (should (>= 1))
   (should (>= 3 2))
   (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
+  (should (>= (+ 1.0 most-positive-fixnum) most-positive-fixnum))
   (should-not (apply #'>= '(3 8 3)))
   (should-error (>= 9 8 'foo))
   ;; Short circuits before getting to bad arg