From: Paul Eggert <eggert@cs.ucla.edu>
Date: Tue, 11 Sep 2018 18:30:48 +0000 (-0700)
Subject: Fix (round 1e+INF) core dump
X-Git-Tag: emacs-27.0.90~4432
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=038a09041af20ed373b15715fbc859d4a305dda8;p=emacs.git

Fix (round 1e+INF) core dump

* src/bignum.c (double_to_integer): Signal an error
if D cannot be converted, instead of dumping core.
* test/src/floatfns-tests.el (special-round): New test.
---

diff --git a/src/bignum.c b/src/bignum.c
index 2da2c961c47..5e86c404b70 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -23,6 +23,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include "lisp.h"
 
+#include <math.h>
 #include <stdlib.h>
 
 /* mpz global temporaries.  Making them global saves the trouble of
@@ -64,10 +65,13 @@ bignum_to_double (Lisp_Object n)
   return mpz_get_d (XBIGNUM (n)->value);
 }
 
-/* Return D, converted to a Lisp integer.  Discard any fraction.  */
+/* Return D, converted to a Lisp integer.  Discard any fraction.
+   Signal an error if D cannot be converted.  */
 Lisp_Object
 double_to_integer (double d)
 {
+  if (!isfinite (d))
+    overflow_error ();
   mpz_set_d (mpz[0], d);
   return make_integer_mpz ();
 }
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index 9a382058b43..3dcddc7f26b 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -94,4 +94,19 @@
                       (or (/= cdelta fdelta)
                           (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)))))))
+
 (provide 'floatfns-tests)