1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-04 08:47:11 +00:00

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.
This commit is contained in:
Paul Eggert 2018-07-18 03:16:54 -07:00
parent ba6cc1d04c
commit c70d22f70b
3 changed files with 53 additions and 35 deletions

View File

@ -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:

View File

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

View File

@ -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))