Fix bug with eql etc. on NaNs

Fix a bug where eql, sxhash-eql, memql, and make-hash-table
were not consistent on NaNs.  Likewise for equal,
sxhash-equal, member, and make-hash-table.  Some of these
functions ignored NaN significands, whereas others treated
them as significant.  It's more logical to treat significands
as significant, and this typically makes eql a bit more
efficient on floats, with just one integer comparison instead
of one to three floating-point comparisons.
* doc/lispref/numbers.texi (Float Basics): Document that
NaNs are never numerically equal, but might be eql.
* src/fns.c (WORDS_PER_DOUBLE): Move to top level of this file.
(union double_and_words): Now named, and at the top level of this file.
(same_float): New function.
(Fmemql, Feql, internal_equal, cmpfn_eql): Use it, so that
the corresponding functions treat NaNs consistently.
(sxhash_float): Simplify based on above-mentioned changes.

* test/src/fns-tests.el (fns-tests-equality-nan): New test.

diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 2fed2b642fd8c23f4d7555abf588c913c9fee1a3..6c51b849d355b8c56cb31d282c5dd3998dbcdd2c 100644 (file)
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -232,13 +232,18 @@ distinguish them.
 @cindex negative infinity
 @cindex infinity
 @cindex NaN
+@findex eql
+@findex sxhash-eql
   The @acronym{IEEE} floating-point standard supports positive
 infinity and negative infinity as floating-point values.  It also
 provides for a class of values called NaN, or ``not a number'';
 numerical functions return such values in cases where there is no
 correct answer.  For example, @code{(/ 0.0 0.0)} returns a NaN@.
-Although NaN values carry a sign, for practical purposes there is no other
-significant difference between different NaN values in Emacs Lisp.
+A NaN is never numerically equal to any value, not even to itself.
+NaNs carry a sign and a significand, and non-numeric functions like
+@code{eql} and @code{sxhash-eql} treat two NaNs as equal when their
+signs and significands agree.  Significands of NaNs are
+machine-dependent and are not directly visible to Emacs Lisp.
 
 Here are read syntaxes for these special floating-point values:
 

diff --git a/src/fns.c b/src/fns.c
index c171784d29013bcfcfb554a76508a8bfe89d634b..10997da0d46345607e6ec5c0dd51791444a70f25 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -1419,6 +1419,29 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
   return Faref (sequence, n);
 }
 
+enum { WORDS_PER_DOUBLE = (sizeof (double) / sizeof (EMACS_UINT)
+                          + (sizeof (double) % sizeof (EMACS_UINT) != 0)) };
+union double_and_words
+{
+  double val;
+  EMACS_UINT word[WORDS_PER_DOUBLE];
+};
+
+/* Return true if X and Y are the same floating-point value.
+   This looks at X's and Y's representation, since (unlike '==')
+   it returns true if X and Y are the same NaN.  */
+static bool
+same_float (Lisp_Object x, Lisp_Object y)
+{
+  union double_and_words
+    xu = { .val = XFLOAT_DATA (x) },
+    yu = { .val = XFLOAT_DATA (y) };
+  EMACS_UINT neql = 0;
+  for (int i = 0; i < WORDS_PER_DOUBLE; i++)
+    neql |= xu.word[i] ^ yu.word[i];
+  return !neql;
+}
+
 DEFUN ("member", Fmember, Smember, 2, 2, 0,
        doc: /* Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.
 The value is actually the tail of LIST whose car is ELT.  */)
@@ -1457,7 +1480,7 @@ The value is actually the tail of LIST whose car is ELT.  */)
   FOR_EACH_TAIL (tail)
     {
       Lisp_Object tem = XCAR (tail);
-      if (FLOATP (tem) && equal_no_quit (elt, tem))
+      if (FLOATP (tem) && same_float (elt, tem))
        return tail;
     }
   CHECK_LIST_END (tail, list);
@@ -2175,7 +2198,7 @@ Floating-point numbers of equal value are `eql', but they may not be `eq'.  */)
   (Lisp_Object obj1, Lisp_Object obj2)
 {
   if (FLOATP (obj1))
-    return equal_no_quit (obj1, obj2) ? Qt : Qnil;
+    return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil;
   else
     return EQ (obj1, obj2) ? Qt : Qnil;
 }
@@ -2266,13 +2289,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
   switch (XTYPE (o1))
     {
     case Lisp_Float:
-      {
-       double d1 = XFLOAT_DATA (o1);
-       double d2 = XFLOAT_DATA (o2);
-       /* If d is a NaN, then d != d. Two NaNs should be `equal' even
-          though they are not =.  */
-       return d1 == d2 || (d1 != d1 && d2 != d2);
-      }
+      return same_float (o1, o2);
 
     case Lisp_Cons:
       if (equal_kind == EQUAL_NO_QUIT)
@@ -3706,24 +3723,20 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return XINT (AREF (h->index, idx));
 }
 
-/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
-   HASH2 in hash table H using `eql'.  Value is true if KEY1 and
-   KEY2 are the same.  */
+/* Compare KEY1 and KEY2 in hash table HT using `eql'.  Value is true
+   if KEY1 and KEY2 are the same.  KEY1 and KEY2 must not be eq.  */
 
 static bool
 cmpfn_eql (struct hash_table_test *ht,
           Lisp_Object key1,
           Lisp_Object key2)
 {
-  return (FLOATP (key1)
-         && FLOATP (key2)
-         && XFLOAT_DATA (key1) == XFLOAT_DATA (key2));
+  return FLOATP (key1) && FLOATP (key2) && same_float (key1, key2);
 }
 
 
-/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
-   HASH2 in hash table H using `equal'.  Value is true if KEY1 and
-   KEY2 are the same.  */
+/* Compare KEY1 and KEY2 in hash table HT using `equal'.  Value is
+   true if KEY1 and KEY2 are the same.  */
 
 static bool
 cmpfn_equal (struct hash_table_test *ht,
@@ -3734,9 +3747,8 @@ cmpfn_equal (struct hash_table_test *ht,
 }
 
 
-/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code
-   HASH2 in hash table H using H->user_cmp_function.  Value is true
-   if KEY1 and KEY2 are the same.  */
+/* Compare KEY1 and KEY2 in hash table HT using HT->user_cmp_function.
+   Value is true if KEY1 and KEY2 are the same.  */
 
 static bool
 cmpfn_user_defined (struct hash_table_test *ht,
@@ -4328,18 +4340,8 @@ static EMACS_UINT
 sxhash_float (double val)
 {
   EMACS_UINT hash = 0;
-  enum {
-    WORDS_PER_DOUBLE = (sizeof val / sizeof hash
-                       + (sizeof val % sizeof hash != 0))
-  };
-  union {
-    double val;
-    EMACS_UINT word[WORDS_PER_DOUBLE];
-  } u;
-  int i;
-  u.val = val;
-  memset (&u.val + 1, 0, sizeof u - sizeof u.val);
-  for (i = 0; i < WORDS_PER_DOUBLE; i++)
+  union double_and_words u = { .val = val };
+  for (int i = 0; i < WORDS_PER_DOUBLE; i++)
     hash = sxhash_combine (hash, u.word[i]);
   return SXHASH_REDUCE (hash);
 }

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d9cca557cf2d4c7a4842fb3f088c400b85a918ee..e4b9cbe25a4ade000d050d076d4bfdbd2864985d 100644 (file)
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -23,6 +23,17 @@
 
 (require 'cl-lib)
 
+;; Test that equality predicates work correctly on NaNs when combined
+;; with hash tables based on those predicates.  This was not the case
+;; for eql in Emacs 26.
+(ert-deftest fns-tests-equality-nan ()
+  (dolist (test (list #'eq #'eql #'equal))
+    (let* ((h (make-hash-table :test test))
+           (nan 0.0e+NaN)
+           (-nan (- nan)))
+      (puthash nan t h)
+      (should (eq (funcall test nan -nan) (gethash -nan h))))))
+
 (ert-deftest fns-tests-reverse ()
   (should-error (reverse))
   (should-error (reverse 1))