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.

2 files changed, 59 insertions, 41 deletions

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;
 }