diff options
| author | Tom Tromey | 2018-08-04 10:50:35 -0600 |
|---|---|---|
| committer | Tom Tromey | 2018-08-04 10:50:35 -0600 |
| commit | 91d505d8e2cd8a5736f4ed76bb5aabfbc4410e89 (patch) | |
| tree | 7783e8f6bf76dda146880afdacb2f2db09f4b0eb | |
| parent | bc8ff54efee05f4a2769be32046866ed1e152b41 (diff) | |
| download | emacs-91d505d8e2cd8a5736f4ed76bb5aabfbc4410e89.tar.gz emacs-91d505d8e2cd8a5736f4ed76bb5aabfbc4410e89.zip | |
Fix bignum comparisons with NaN
* src/data.c (isnan): Move earlier.
(bignumcompare): Explicitly handle NaN.
* test/src/data-tests.el (data-tests-min): Add NaN tests
for bignum.
(data-check-sign): Fix for previous patch.
* test/src/fns-tests.el (test-bignum-eql): Add NaN test.
| -rw-r--r-- | src/data.c | 24 | ||||
| -rw-r--r-- | test/src/data-tests.el | 6 | ||||
| -rw-r--r-- | test/src/fns-tests.el | 3 |
3 files changed, 24 insertions, 9 deletions
diff --git a/src/data.c b/src/data.c index 3d55d9d17d5..4388a2b0ffc 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2397,6 +2397,10 @@ bool-vector. IDX starts at 0. */) | |||
| 2397 | 2397 | ||
| 2398 | /* Arithmetic functions */ | 2398 | /* Arithmetic functions */ |
| 2399 | 2399 | ||
| 2400 | #ifndef isnan | ||
| 2401 | # define isnan(x) ((x) != (x)) | ||
| 2402 | #endif | ||
| 2403 | |||
| 2400 | static Lisp_Object | 2404 | static Lisp_Object |
| 2401 | bignumcompare (Lisp_Object num1, Lisp_Object num2, | 2405 | bignumcompare (Lisp_Object num1, Lisp_Object num2, |
| 2402 | enum Arith_Comparison comparison) | 2406 | enum Arith_Comparison comparison) |
| @@ -2407,7 +2411,13 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, | |||
| 2407 | if (BIGNUMP (num1)) | 2411 | if (BIGNUMP (num1)) |
| 2408 | { | 2412 | { |
| 2409 | if (FLOATP (num2)) | 2413 | if (FLOATP (num2)) |
| 2410 | cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); | 2414 | { |
| 2415 | /* Note that GMP doesn't define comparisons against NaN, so | ||
| 2416 | we need to handle them specially. */ | ||
| 2417 | if (isnan (XFLOAT_DATA (num2))) | ||
| 2418 | return Qnil; | ||
| 2419 | cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2)); | ||
| 2420 | } | ||
| 2411 | else if (FIXNUMP (num2)) | 2421 | else if (FIXNUMP (num2)) |
| 2412 | { | 2422 | { |
| 2413 | if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX) | 2423 | if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX) |
| @@ -2431,7 +2441,13 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2, | |||
| 2431 | { | 2441 | { |
| 2432 | eassume (BIGNUMP (num2)); | 2442 | eassume (BIGNUMP (num2)); |
| 2433 | if (FLOATP (num1)) | 2443 | if (FLOATP (num1)) |
| 2434 | cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); | 2444 | { |
| 2445 | /* Note that GMP doesn't define comparisons against NaN, so | ||
| 2446 | we need to handle them specially. */ | ||
| 2447 | if (isnan (XFLOAT_DATA (num1))) | ||
| 2448 | return Qnil; | ||
| 2449 | cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1)); | ||
| 2450 | } | ||
| 2435 | else | 2451 | else |
| 2436 | { | 2452 | { |
| 2437 | eassume (FIXNUMP (num1)); | 2453 | eassume (FIXNUMP (num1)); |
| @@ -3021,10 +3037,6 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) | |||
| 3021 | return unbind_to (count, make_number (accum)); | 3037 | return unbind_to (count, make_number (accum)); |
| 3022 | } | 3038 | } |
| 3023 | 3039 | ||
| 3024 | #ifndef isnan | ||
| 3025 | # define isnan(x) ((x) != (x)) | ||
| 3026 | #endif | ||
| 3027 | |||
| 3028 | static Lisp_Object | 3040 | static Lisp_Object |
| 3029 | float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, | 3041 | float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code, |
| 3030 | ptrdiff_t nargs, Lisp_Object *args) | 3042 | ptrdiff_t nargs, Lisp_Object *args) |
diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 07159df48cf..ee6a3eb9222 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el | |||
| @@ -105,7 +105,9 @@ | |||
| 105 | (should (isnan (min 0.0e+NaN))) | 105 | (should (isnan (min 0.0e+NaN))) |
| 106 | (should (isnan (min 0.0e+NaN 1 2))) | 106 | (should (isnan (min 0.0e+NaN 1 2))) |
| 107 | (should (isnan (min 1.0 0.0e+NaN))) | 107 | (should (isnan (min 1.0 0.0e+NaN))) |
| 108 | (should (isnan (min 1.0 0.0e+NaN 1.1)))) | 108 | (should (isnan (min 1.0 0.0e+NaN 1.1))) |
| 109 | (should (isnan (min 1.0 0.0e+NaN 1.1 (1+ most-positive-fixnum)))) | ||
| 110 | (should (isnan (max 1.0 0.0e+NaN 1.1 (1+ most-positive-fixnum))))) | ||
| 109 | 111 | ||
| 110 | (defun data-tests-popcnt (byte) | 112 | (defun data-tests-popcnt (byte) |
| 111 | "Calculate the Hamming weight of BYTE." | 113 | "Calculate the Hamming weight of BYTE." |
| @@ -618,6 +620,6 @@ comparing the subr with a much slower lisp implementation." | |||
| 618 | (should (= (ash most-negative-fixnum 1) | 620 | (should (= (ash most-negative-fixnum 1) |
| 619 | (* most-negative-fixnum 2))) | 621 | (* most-negative-fixnum 2))) |
| 620 | (should (= (lsh most-negative-fixnum 1) | 622 | (should (= (lsh most-negative-fixnum 1) |
| 621 | (* (abs most-negative-fixnum) 2)))) | 623 | (* most-negative-fixnum 2)))) |
| 622 | 624 | ||
| 623 | ;;; data-tests.el ends here | 625 | ;;; data-tests.el ends here |
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f5f3b892441..d440cfabda4 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el | |||
| @@ -599,6 +599,7 @@ | |||
| 599 | (y (+ most-positive-fixnum 1))) | 599 | (y (+ most-positive-fixnum 1))) |
| 600 | (should (eq x x)) | 600 | (should (eq x x)) |
| 601 | (should (eql x y)) | 601 | (should (eql x y)) |
| 602 | (should (equal x y)))) | 602 | (should (equal x y)) |
| 603 | (should-not (eql x 0.0e+NaN)))) | ||
| 603 | 604 | ||
| 604 | (provide 'fns-tests) | 605 | (provide 'fns-tests) |