From: Mattias Engdegård <mattiase@acm.org>
Date: Thu, 4 Jul 2024 12:46:54 +0000 (+0200)
Subject: Compare fixnums and floats accurately in value<
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2f7b6a3e4d75760a33e32b7ae65102b8314849fc;p=emacs.git

Compare fixnums and floats accurately in value<

Make `value<` compare fixnums and floats by value, as `<` does, instead
of coercing the fixnum to a float first which is what C would do.
This matters when the fixnum cannot be represented as a float. For
example, C would evaluate

  72057594037927935 < 72057594037927936.0

to false since the operands are converted to the same floating-point
number.

* src/fns.c (fixnum_float_cmp): New.
(value_cmp): Use it.
* test/src/fns-tests.el (fns-value<-ordered, fns-value<-unordered):
New test cases.

(cherry picked from commit f9f4f054bc15791ff63252e101dbf08bb4eb33c1)
---

diff --git a/src/fns.c b/src/fns.c
index 3b439defa01..07afcada62f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3012,6 +3012,23 @@ bool_vector_cmp (Lisp_Object a, Lisp_Object b)
   return (d & aw) ? 1 : -1;
 }
 
+/* Return -1 if a<b, 1 if a>b, 0 if a=b or if b is NaN.  */
+static inline int
+fixnum_float_cmp (EMACS_INT a, double b)
+{
+  double fa = (double)a;
+  if (fa == b)
+    {
+      /* This doesn't mean that a=b because the conversion may have
+	 rounded, but b must be an integer that fits in an EMACS_INT
+	 and we can compare in the integer domain instead.  */
+      EMACS_INT ib = b;		/* lossless conversion */
+      return a < ib ? -1 : a > ib;
+    }
+  else
+    return fa < b ? -1 : fa > b;   /* return 0 if b is NaN */
+}
+
 /* Return -1, 0 or 1 to indicate whether a<b, a=b or a>b in the sense of value<.
    In particular 0 does not mean equality in the sense of Fequal, only
    that the arguments cannot be ordered yet they can be compared (same
@@ -3035,7 +3052,7 @@ value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth)
 	if (FIXNUMP (b))
 	  return ia < XFIXNUM (b) ? -1 : 1;   /* we know that a != b */
 	if (FLOATP (b))
-	  return ia < XFLOAT_DATA (b) ? -1 : ia > XFLOAT_DATA (b);
+	  return fixnum_float_cmp (ia, XFLOAT_DATA (b));
 	if (BIGNUMP (b))
 	  return -mpz_sgn (*xbignum_val (b));
       }
@@ -3170,7 +3187,7 @@ value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth)
 	if (FLOATP (b))
 	  return fa < XFLOAT_DATA (b) ? -1 : fa > XFLOAT_DATA (b);
 	if (FIXNUMP (b))
-	  return fa < XFIXNUM (b) ? -1 : fa > XFIXNUM (b);
+	  return -fixnum_float_cmp (XFIXNUM (b), fa);
 	if (BIGNUMP (b))
 	  {
 	    if (isnan (fa))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a73a7a42f26..c5908c7b3d5 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1606,6 +1606,13 @@
                    (1.5 . 1.6) (-1.3 . -1.2) (-13.0 . 12.0)
                    ;; floats/fixnums
                    (1 . 1.1) (1.9 . 2) (-2.0 . 1) (-2 . 1.0)
+                   ;; fixnums that can't be represented as floats
+                   (72057594037927935 . 72057594037927936.0)
+                   (72057594037927936.0 . 72057594037927937)
+                   (-72057594037927936.0 . -72057594037927935)
+                   (-72057594037927937 . -72057594037927936.0)
+                   (2305843009213693951 . 2305843009213693952.0)
+
                    ;; floats/bignums
                    (,big . ,(float (* 2 big))) (,(float big) . ,(* 2 big))
                    ;; symbols
@@ -1683,6 +1690,9 @@
                  ;; numbers
                  (0 . 0.0) (0 . -0.0) (0.0 . -0.0)
 
+                 (72057594037927936 . 72057594037927936.0)
+                 (1 . 0.0e+NaN)
+
                  ;; symbols
                  (a . #:a)