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:
parent
ba6cc1d04c
commit
c70d22f70b
@ -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:
|
||||
|
||||
|
68
src/fns.c
68
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);
|
||||
}
|
||||
|
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user