From c70d22f70b77b053d01c7380122d166ecb728610 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 18 Jul 2018 03:16:54 -0700 Subject: [PATCH] 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. --- doc/lispref/numbers.texi | 9 +++++-- src/fns.c | 68 +++++++++++++++++++++++++----------------------- test/src/fns-tests.el | 11 ++++++++ 3 files changed, 53 insertions(+), 35 deletions(-) diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 2fed2b6..6c51b84 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -232,13 +232,18 @@ Float Basics @cindex negative infinity @cindex infinity @cindex NaN address@hidden eql address@hidden 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 address@hidden -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 address@hidden 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 c171784..10997da 100644 --- 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 d9cca55..e4b9cbe 100644 --- 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)) -- 2.7.4