Fix bugs when rounding to bignums

Also, since Emacs historically reported a range error when
rounding operations overflowed, do that consistently for all
bignum overflows.
* doc/lispref/errors.texi (Standard Errors):
* doc/lispref/numbers.texi (Integer Basics): Document range errors.
* src/alloc.c (range_error): Rename from integer_overflow.
All uses changed.
* src/floatfns.c (rounding_driver): When the result of a floating
point rounding operation does not fit into a fixnum, put it
into a bignum instead of always signaling an range error.
* test/src/floatfns-tests.el (divide-extreme-sign):
These tests now return the mathematically-correct answer
instead of signaling an error.
(bignum-round): Check that integers round to themselves.

4 files changed, 22 insertions, 10 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 24a24aab96b..cdcd465ac5a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3771,7 +3771,7 @@ make_number (mpz_t value)
   /* The documentation says integer-width should be nonnegative, so
      a single comparison suffices even though 'bits' is unsigned.  */
   if (integer_width < bits)
-    integer_overflow ();
+    range_error ();
 
   struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
                                                  PVEC_BIGNUM);
@@ -7203,9 +7203,9 @@ verify_alloca (void)
 /* Memory allocation for GMP.  */
 
 void
-integer_overflow (void)
+range_error (void)
 {
-  error ("Integer too large to be represented");
+  xsignal0 (Qrange_error);
 }
 
 static void *
diff --git a/src/data.c b/src/data.c
index 08c7271dd79..170a74a6589 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2406,7 +2406,7 @@ static void
 emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2)
 {
   if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2))
-    integer_overflow ();
+    range_error ();
   mpz_mul (rop, op1, op2);
 }
 
@@ -2420,7 +2420,7 @@ emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2)
 
   mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS;
   if (lim - emacs_mpz_size (op1) < op2limbs)
-    integer_overflow ();
+    range_error ();
   mpz_mul_2exp (rop, op1, op2);
 }
 
@@ -2434,7 +2434,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp)
 
   int nbase = emacs_mpz_size (base), n;
   if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n)
-    integer_overflow ();
+    range_error ();
   mpz_pow_ui (rop, base, exp);
 }
 
@@ -3398,7 +3398,7 @@ expt_integer (Lisp_Object x, Lisp_Object y)
            && mpz_fits_ulong_p (XBIGNUM (y)->value))
     exp = mpz_get_ui (XBIGNUM (y)->value);
   else
-    integer_overflow ();
+    range_error ();
 
   mpz_t val;
   mpz_init (val);
diff --git a/src/floatfns.c b/src/floatfns.c
index c09fe9d6a5b..e7884864eef 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -410,7 +410,12 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
       if (! FIXNUM_OVERFLOW_P (ir))
         return make_fixnum (ir);
     }
-  xsignal2 (Qrange_error, build_string (name), arg);
+  mpz_t drz;
+  mpz_init (drz);
+  mpz_set_d (drz, dr);
+  Lisp_Object rounded = make_number (drz);
+  mpz_clear (drz);
+  return rounded;
 }
 
 static void
@@ -501,13 +506,20 @@ systems, but 2 on others.  */)
   return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round");
 }
 
+/* Since rounding_driver truncates anyway, no need to call 'trunc'.  */
+static double
+identity (double x)
+{
+  return x;
+}
+
 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0,
        doc: /* Truncate a floating point number to an int.
 Rounds ARG toward zero.
 With optional DIVISOR, truncate ARG/DIVISOR.  */)
   (Lisp_Object arg, Lisp_Object divisor)
 {
-  return rounding_driver (arg, divisor, trunc, mpz_tdiv_q, "truncate");
+  return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate");
 }
 
 
diff --git a/src/lisp.h b/src/lisp.h
index c5593b21008..bca4dfbb603 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3708,7 +3708,7 @@ extern void display_malloc_warning (void);
 extern ptrdiff_t inhibit_garbage_collection (void);
 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void free_cons (struct Lisp_Cons *);
-extern _Noreturn void integer_overflow (void);
+extern _Noreturn void range_error (void);
 extern void init_alloc_once (void);
 extern void init_alloc (void);
 extern void syms_of_alloc (void);