From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 15 Nov 2019 02:51:17 +0000 (-0800)
Subject: Handle weird cases like (ceil 0 0.0)
X-Git-Tag: emacs-27.0.90~618
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8b848def9bc3c4ad786670d0447a6fb396f2ff30;p=emacs.git

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 a626845377a..30526a16443 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 7f1d4691bf0..0eef3de75f7 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)