From: Paul Eggert Date: Wed, 1 Mar 2017 20:29:37 +0000 (-0800) Subject: Fix rounding error in ‘ceiling’ etc. X-Git-Tag: emacs-26.0.90~679 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=207ee94b1d1f3cbe5ddd87a4cdfae17e5ad8419d;p=emacs.git 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. --- diff --git a/configure.ac b/configure.ac index dcba7eb2c24..6926076fadc 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 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 . */ 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 @@ -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)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 7b4f41aab5d..14124ef85fb 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 00000000000..a2116a59459 --- /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 . + +(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)