[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master c70d22f: Fix bug with eql etc. on NaNs
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master c70d22f: Fix bug with eql etc. on NaNs |
Date: |
Wed, 18 Jul 2018 06:18:58 -0400 (EDT) |
branch: master
commit c70d22f70b77b053d01c7380122d166ecb728610
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
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 @@ distinguish them.
@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))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master c70d22f: Fix bug with eql etc. on NaNs,
Paul Eggert <=