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.

diff --git a/src/floatfns.c b/src/floatfns.c
index a626845377affaf941f10ff17198515572650a14..30526a1644330c0b71bbb155f4c0094a7a3c5654 100644 (file)
--- 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 7f1d4691bf05bf08c185f882b513281ab81c11d5..0eef3de75f75dd4c4d8202c87e52c755153c9e49 100644 (file)
--- 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)