Fix rounding error in ‘ceiling’ etc.

Without this fix, (ceiling most-negative-fixnum -1.0) returns
most-negative-fixnum instead of correctly signaling range-error,
and similarly for floor, round, and truncate.
* configure.ac (trunc): Add a check, since Gnulib’s doc says
‘trunc’ is missing from MSVC 9.  The Gnulib doc says ‘trunc’ is
also missing from some other older operating systems like Solaris
9 which I know we don’t care about any more, so MSVC is the only
reason to worry about ‘trunc’ here.
* src/editfns.c (styled_format): Formatting a float with %c is now an
error.  The old code did not work in general, because FIXNUM_OVERFLOW_P
had rounding errors.  Besides, the "if (FLOATP (...))" was in there
only as a result of my misunderstanding old code that I introduced
2011.  Although %d etc. is sometimes used on floats that represent
huge UIDs or PIDs etc. that do not fit in fixnums, this cannot
happen with characters.
* src/floatfns.c (rounding_driver): Rework to do the right thing
when the intermediate result equals 2.305843009213694e+18, i.e.,
is exactly 1 greater than MOST_POSITIVE_FIXNUM on a 64-bit host.
Simplify so that only one section of code checks for overflow,
rather than two.
(double_identity): Remove.  All uses changed to ...
(emacs_trunc): ... this new function.  Add replacement for
platforms that lack ‘trunc’.
* src/lisp.h (FIXNUM_OVERFLOW_P, make_fixnum_or_float):
Make it clear that the arg cannot be floating point.
* test/src/editfns-tests.el (format-c-float): New test.
* test/src/floatfns-tests.el: New file, to test for this bug.

3 files changed, 38 insertions, 46 deletions

diff --git a/src/editfns.c b/src/editfns.c
index 4618164d008..e3c8548b5a4 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4119,12 +4119,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
             }
           else if (conversion == 'c')
             {
-              if (FLOATP (args[n]))
-                {
-                  double d = XFLOAT_DATA (args[n]);
-                  args[n] = make_number (FIXNUM_OVERFLOW_P (d) ? -1 : d);
-                }
-
               if (INTEGERP (args[n]) && ! ASCII_CHAR_P (XINT (args[n])))
                 {
                   if (!multibyte)
@@ -4241,7 +4235,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
                       || conversion == 'X'))
             error ("Invalid format operation %%%c",
                    STRING_CHAR ((unsigned char *) format - 1));
-          else if (! NUMBERP (args[n]))
+          else if (! (INTEGERP (args[n])
+                      || (FLOATP (args[n]) && conversion != 'c')))
             error ("Format specifier doesn't match argument type");
           else
             {
diff --git a/src/floatfns.c b/src/floatfns.c
index c476627b33b..96711faff62 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -36,7 +36,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
    isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], *logb
    (approximately), lrint/llrint, lround/llround, nan, nearbyint,
    nextafter, nexttoward, remainder, remquo, *rint, round, scalbln,
-   scalbn, signbit, tgamma, trunc.
+   scalbn, signbit, tgamma, *trunc.
  */
 
 #include <config.h>
@@ -333,47 +333,42 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
 {
   CHECK_NUMBER_OR_FLOAT (arg);
 
-  if (! NILP (divisor))
+  double d;
+  if (NILP (divisor))
+    {
+      if (! FLOATP (arg))
+        return arg;
+      d = XFLOAT_DATA (arg);
+    }
+  else
     {
-      EMACS_INT i1, i2;
-
       CHECK_NUMBER_OR_FLOAT (divisor);
-
-      if (FLOATP (arg) || FLOATP (divisor))
+      if (!FLOATP (arg) && !FLOATP (divisor))
         {
-          double f1, f2;
-
-          f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg);
-          f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor));
-          if (! IEEE_FLOATING_POINT && f2 == 0)
+          if (XINT (divisor) == 0)
             xsignal0 (Qarith_error);
-
-          f1 = (*double_round) (f1 / f2);
-          if (FIXNUM_OVERFLOW_P (f1))
-            xsignal3 (Qrange_error, build_string (name), arg, divisor);
-          arg = make_number (f1);
-          return arg;
+          return make_number (int_round2 (XINT (arg), XINT (divisor)));
         }
 
-      i1 = XINT (arg);
-      i2 = XINT (divisor);
-
-      if (i2 == 0)
+      double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg);
+      double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor);
+      if (! IEEE_FLOATING_POINT && f2 == 0)
         xsignal0 (Qarith_error);
-
-      XSETINT (arg, (*int_round2) (i1, i2));
-      return arg;
+      d = f1 / f2;
     }
 
-  if (FLOATP (arg))
+  /* Round, coarsely test for fixnum overflow before converting to
+     EMACS_INT (to avoid undefined C behavior), and then exactly test
+     for overflow after converting (as FIXNUM_OVERFLOW_P is inaccurate
+     on floats).  */
+  double dr = double_round (d);
+  if (fabs (dr) < 2 * (MOST_POSITIVE_FIXNUM + 1))
     {
-      double d = (*double_round) (XFLOAT_DATA (arg));
-      if (FIXNUM_OVERFLOW_P (d))
-        xsignal2 (Qrange_error, build_string (name), arg);
-      arg = make_number (d);
+      EMACS_INT ir = dr;
+      if (! FIXNUM_OVERFLOW_P (ir))
+        return make_number (ir);
     }
-
-  return arg;
+  xsignal2 (Qrange_error, build_string (name), arg);
 }
 
 static EMACS_INT
@@ -423,11 +418,15 @@ emacs_rint (double d)
 }
 #endif
 
+#ifdef HAVE_TRUNC
+#define emacs_trunc trunc
+#else
 static double
-double_identity (double d)
+emacs_trunc (double d)
 {
-  return d;
+  return (d < 0 ? ceil : floor) (d);
 }
+#endif
 
 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0,
        doc: /* Return the smallest integer no less than ARG.
@@ -466,7 +465,7 @@ Rounds ARG toward zero.
 With optional DIVISOR, truncate ARG/DIVISOR.  */)
   (Lisp_Object arg, Lisp_Object divisor)
 {
-  return rounding_driver (arg, divisor, double_identity, truncate2,
+  return rounding_driver (arg, divisor, emacs_trunc, truncate2,
                           "truncate");
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 238c20bc189..a757dfdbb31 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1031,9 +1031,7 @@ INLINE bool
   return lisp_h_EQ (x, y);
 }
 
-/* Value is true if I doesn't fit into a Lisp fixnum.  It is
-   written this way so that it also works if I is of unsigned
-   type or if I is a NaN.  */
+/* True if the possibly-unsigned integer I doesn't fit in a Lisp fixnum.  */
 
 #define FIXNUM_OVERFLOW_P(i) \
   (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
@@ -4374,8 +4372,8 @@ extern void init_system_name (void);
    because 'abs' is reserved by the C standard.  */
 #define eabs(x)         ((x) < 0 ? -(x) : (x))
 
-/* Return a fixnum or float, depending on whether VAL fits in a Lisp
-   fixnum.  */
+/* Return a fixnum or float, depending on whether the integer VAL fits
+   in a Lisp fixnum.  */
 
 #define make_fixnum_or_float(val) \
    (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))