[Emacs-diffs] master 207ee94: Fix rounding error in ‘ceiling’ etc.

[Paul Eggert]

branch: master
commit 207ee94b1d1f3cbe5ddd87a4cdfae17e5ad8419d
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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               |  2 +-
 src/editfns.c              |  9 ++-----
 src/floatfns.c             | 67 +++++++++++++++++++++++-----------------------
 src/lisp.h                 |  8 +++---
 test/src/editfns-tests.el  |  3 +++
 test/src/floatfns-tests.el | 28 +++++++++++++++++++
 6 files changed, 70 insertions(+), 47 deletions(-)

diff --git a/configure.ac b/configure.ac
index dcba7eb..6926076 100644
--- a/configure.ac
+++ b/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 \
diff --git a/src/editfns.c b/src/editfns.c
index 4618164..e3c8548 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 c476627..96711fa 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 238c20b..a757dfd 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))
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 7b4f41a..14124ef 100644
--- a/test/src/editfns-tests.el
+++ b/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
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
new file mode 100644
index 0000000..a2116a5
--- /dev/null
+++ b/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)