[Emacs-diffs] master 038a090 2/3: Fix (round 1e+INF) core dump

[Paul Eggert]

branch: master
commit 038a09041af20ed373b15715fbc859d4a305dda8
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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.
---
 src/bignum.c               |  6 +++++-
 test/src/floatfns-tests.el | 15 +++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/src/bignum.c b/src/bignum.c
index 2da2c96..5e86c40 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 9a38205..3dcddc7 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)