Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix rounding errors in <, =, etc.

Browse source 
* etc/NEWS: Document this.
* src/bytecode.c (exec_byte_code):
* src/data.c (arithcompare):
Do not lose information when comparing floats to integers.
* test/src/data-tests.el (data-tests-=, data-tests-<)
(data-tests->, data-tests-<=, data-tests->=):
Test this.
This commit is contained in:
Paul Eggert 2017-03-02 09:11:11 -08:00
parent d546be31a9
commit 4e2622bf0d
4 changed files with 71 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
etc/NEWS
View file

@ -902,6 +902,11 @@ interpreting consecutive runs of numerical characters as numbers, and
compares their numerical values. According to this predicate,
"foo2.png" is smaller than "foo12.png".
---
** Numeric comparisons no longer return incorrect answers due to
internal rounding errors. For example, (< most-positive-fixnum (+ 1.0
most-positive-fixnum)) now correctly returns t on 64-bit hosts.
+++
** The new function 'char-from-name' converts a Unicode name string
to the corresponding character code.

16
src/bytecode.c
View file

@ -992,18 +992,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Beqlsign):
{
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
bool equal;
if (FLOATP (v1) || FLOATP (v2))
{
double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1);
double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2);
equal = f1 == f2;
}
TOP = arithcompare (v1, v2, ARITH_EQUAL);
else
equal = XINT (v1) == XINT (v2);
TOP = equal ? Qt : Qnil;
{
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
TOP = EQ (v1, v2) ? Qt : Qnil;
}
NEXT;
}

86
src/data.c
View file

@ -2392,68 +2392,90 @@ bool-vector. IDX starts at 0. */)
/* Arithmetic functions */
Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison)
arithcompare (Lisp_Object num1, Lisp_Object num2,
enum Arith_Comparison comparison)
{
double f1 = 0, f2 = 0;
bool floatp = 0;
double f1, f2;
EMACS_INT i1, i2;
bool fneq;
bool test;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
if (FLOATP (num1) || FLOATP (num2))
/* If either arg is floating point, set F1 and F2 to the 'double'
approximations of the two arguments. Regardless, set I1 and I2
to integers that break ties if the floating point comparison is
either not done or reports equality. */
if (FLOATP (num1))
{
floatp = 1;
f1 = (FLOATP (num1)) ? XFLOAT_DATA (num1) : XINT (num1);
f2 = (FLOATP (num2)) ? XFLOAT_DATA (num2) : XINT (num2);
f1 = XFLOAT_DATA (num1);
if (FLOATP (num2))
{
i1 = i2 = 0;
f2 = XFLOAT_DATA (num2);
}
else
i1 = f2 = i2 = XINT (num2);
fneq = f1 != f2;
}
else
{
i1 = XINT (num1);
if (FLOATP (num2))
{
i2 = f1 = i1;
f2 = XFLOAT_DATA (num2);
fneq = f1 != f2;
}
else
{
i2 = XINT (num2);
fneq = false;
}
}
switch (comparison)
{
case ARITH_EQUAL:
if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
return Qt;
return Qnil;
test = !fneq && i1 == i2;
break;
case ARITH_NOTEQUAL:
if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
return Qt;
return Qnil;
test = fneq || i1 != i2;
break;
case ARITH_LESS:
if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
return Qt;
return Qnil;
test = fneq ? f1 < f2 : i1 < i2;
break;
case ARITH_LESS_OR_EQUAL:
if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
return Qt;
return Qnil;
test = fneq ? f1 <= f2 : i1 <= i2;
break;
case ARITH_GRTR:
if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
return Qt;
return Qnil;
test = fneq ? f1 > f2 : i1 > i2;
break;
case ARITH_GRTR_OR_EQUAL:
if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
return Qt;
return Qnil;
test = fneq ? f1 >= f2 : i1 >= i2;
break;
default:
emacs_abort ();
eassume (false);
}
return test ? Qt : Qnil;
}
static Lisp_Object
arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
ptrdiff_t argnum;
for (argnum = 1; argnum < nargs; ++argnum)
{
if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
return Qnil;
}
for (ptrdiff_t i = 1; i < nargs; i++)
if (NILP (arithcompare (args[i - 1], args[i], comparison)))
return Qnil;
return Qt;
}

6
test/src/data-tests.el
View file

@ -29,6 +29,8 @@
(should (= 1))
(should (= 2 2))
(should (= 9 9 9 9 9 9 9 9 9))
(should (= most-negative-fixnum (float most-negative-fixnum)))
(should-not (= most-positive-fixnum (+ 1.0 most-positive-fixnum)))
(should-not (apply #'= '(3 8 3)))
(should-error (= 9 9 'foo))
;; Short circuits before getting to bad arg
@ -39,6 +41,7 @@
(should (< 1))
(should (< 2 3))
(should (< -6 -1 0 2 3 4 8 9 999))
(should (< 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum)))
(should-not (apply #'< '(3 8 3)))
(should-error (< 9 10 'foo))
;; Short circuits before getting to bad arg
@ -49,6 +52,7 @@
(should (> 1))
(should (> 3 2))
(should (> 6 1 0 -2 -3 -4 -8 -9 -999))
(should (> (+ 1.0 most-positive-fixnum) most-positive-fixnum 0.5))
(should-not (apply #'> '(3 8 3)))
(should-error (> 9 8 'foo))
;; Short circuits before getting to bad arg
@ -59,6 +63,7 @@
(should (<= 1))
(should (<= 2 3))
(should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
(should (<= 0.5 most-positive-fixnum (+ 1.0 most-positive-fixnum)))
(should-not (apply #'<= '(3 8 3 3)))
(should-error (<= 9 10 'foo))
;; Short circuits before getting to bad arg
@ -69,6 +74,7 @@
(should (>= 1))
(should (>= 3 2))
(should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
(should (>= (+ 1.0 most-positive-fixnum) most-positive-fixnum))
(should-not (apply #'>= '(3 8 3)))
(should-error (>= 9 8 'foo))
;; Short circuits before getting to bad arg