[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 8b848de: Handle weird cases like (ceil 0 0.0)
From: |
Paul Eggert |
Subject: |
master 8b848de: Handle weird cases like (ceil 0 0.0) |
Date: |
Thu, 14 Nov 2019 21:52:56 -0500 (EST) |
branch: master
commit 8b848def9bc3c4ad786670d0447a6fb396f2ff30
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
Handle weird cases like (ceil 0 0.0)
* src/floatfns.c (double_integer_scale): Distinguish Inf from NaN.
(rounding_driver): Handle (ceil 0 0.0) and (ceil 0 1.0e+INF).
* test/src/floatfns-tests.el (special-round): Add tests for
weird cases like this.
Avoid crash with (floor 0 0.0)
* src/floatfns.c (rounding_driver): Signal an arithmetic
error if divisor is 0.0 or -0.0, instead of crashing.
---
src/floatfns.c | 29 ++++++++++++++++++++---------
test/src/floatfns-tests.el | 24 +++++++++++-------------
2 files changed, 31 insertions(+), 22 deletions(-)
diff --git a/src/floatfns.c b/src/floatfns.c
index a626845..30526a1 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -340,9 +340,8 @@ This is the same as the exponent of a float. */)
representable as a double.
Return DBL_MANT_DIG - DBL_MIN_EXP (the maximum possible valid
- scale) if D is zero or tiny. Return a value greater than
- DBL_MANT_DIG - DBL_MIN_EXP if there is conversion trouble; on all
- current platforms this can happen only if D is infinite or a NaN. */
+ scale) if D is zero or tiny. Return one greater than that if
+ D is infinite, and two greater than that if D is a NaN. */
int
double_integer_scale (double d)
@@ -351,11 +350,10 @@ double_integer_scale (double d)
return (DBL_MIN_EXP - 1 <= exponent && exponent < INT_MAX
? DBL_MANT_DIG - 1 - exponent
: (DBL_MANT_DIG - DBL_MIN_EXP
- + (exponent == INT_MAX
- || (exponent == FP_ILOGBNAN
- && (FP_ILOGBNAN != FP_ILOGB0 || isnan (d)))
- || (!IEEE_FLOATING_POINT && exponent == INT_MIN
- && (FP_ILOGB0 != INT_MIN || d != 0)))));
+ + ((exponent == FP_ILOGBNAN
+ && (FP_ILOGBNAN != FP_ILOGB0 || isnan (d)))
+ ? 2
+ : exponent == INT_MAX)));
}
/* Convert the Lisp number N to an integer and return a pointer to the
@@ -404,6 +402,7 @@ rounding_driver (Lisp_Object n, Lisp_Object d,
CHECK_NUMBER (d);
+ int dscale = 0;
if (FIXNUMP (d))
{
if (XFIXNUM (d) == 0)
@@ -413,9 +412,21 @@ rounding_driver (Lisp_Object n, Lisp_Object d,
if (FIXNUMP (n))
return make_int (fixnum_divide (XFIXNUM (n), XFIXNUM (d)));
}
+ else if (FLOATP (d))
+ {
+ if (XFLOAT_DATA (d) == 0)
+ xsignal0 (Qarith_error);
+ dscale = double_integer_scale (XFLOAT_DATA (d));
+ }
int nscale = FLOATP (n) ? double_integer_scale (XFLOAT_DATA (n)) : 0;
- int dscale = FLOATP (d) ? double_integer_scale (XFLOAT_DATA (d)) : 0;
+
+ /* If the numerator is finite and the denominator infinite, the
+ quotient is zero and there is no need to try the impossible task
+ of rescaling the denominator. */
+ if (dscale == DBL_MANT_DIG - DBL_MIN_EXP + 1 && nscale < dscale)
+ return make_fixnum (0);
+
int_divide (mpz[0],
*rescale_for_division (n, &mpz[0], nscale, dscale),
*rescale_for_division (d, &mpz[1], dscale, nscale));
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index 7f1d469..0eef3de 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -106,19 +106,17 @@
(zerop (% (round n d) 2)))))))))))
(ert-deftest special-round ()
- (let ((ns '(-1e+INF 1e+INF -1 1 -1e+NaN 1e+NaN)))
- (dolist (n ns)
- (unless (<= (abs n) 1)
- (should-error (ceiling n))
- (should-error (floor n))
- (should-error (round n))
- (should-error (truncate n)))
- (dolist (d ns)
- (unless (<= (abs (/ n d)) 1)
- (should-error (ceiling n d))
- (should-error (floor n d))
- (should-error (round n d))
- (should-error (truncate n d)))))))
+ (dolist (f '(ceiling floor round truncate))
+ (let ((ns '(-1e+INF 1e+INF -1 -0.0 0.0 0 1 -1e+NaN 1e+NaN)))
+ (dolist (n ns)
+ (if (not (<= (abs n) 1))
+ (should-error (funcall f n))
+ (should (= n (funcall f n)))
+ (dolist (d '(-1e+INF 1e+INF))
+ (should (eq 0 (funcall f n d)))))
+ (dolist (d ns)
+ (when (or (zerop d) (= (abs n) 1e+INF) (not (= n n)) (not (= d d)))
+ (should-error (funcall f n d))))))))
(ert-deftest big-round ()
(should (= (floor 54043195528445955 3)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 8b848de: Handle weird cases like (ceil 0 0.0),
Paul Eggert <=