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.

configure.ac

@@ -3881,7 +3881,7 @@ OLD_LIBS=$LIBS
 LIBS="$LIB_PTHREAD $LIB_MATH $LIBS"
 AC_CHECK_FUNCS(accept4 fchdir gethostname \
 getrusage get_current_dir_name \
-lrand48 random rint \
+lrand48 random rint trunc \
 select getpagesize setlocale newlocale \
 getrlimit setrlimit shutdown \
 pthread_sigmask strsignal setitimer \

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
 	    {

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");
 }
 

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))

test/src/editfns-tests.el

@@ -133,4 +133,7 @@
     (should (string= (buffer-string) "éä\"ba÷"))
     (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10)))))
 
+(ert-deftest format-c-float ()
+  (should-error (format "%c" 0.5)))
+
 ;;; editfns-tests.el ends here

test/src/floatfns-tests.el

@@ -0,0 +1,28 @@
+;;; floatfn-tests.el --- tests for floating point operations
+
+;; Copyright 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+(require 'ert)
+
+(ert-deftest divide-extreme-sign ()
+  (should-error (ceiling most-negative-fixnum -1.0))
+  (should-error (floor most-negative-fixnum -1.0))
+  (should-error (round most-negative-fixnum -1.0))
+  (should-error (truncate most-negative-fixnum -1.0)))
+
+(provide 'floatfns-tests)