[Emacs-diffs] master 0d55c44 4/4: Compare and round more carefully

[Paul Eggert]

branch: master
commit 0d55c44a9a00da3b8542e92586654adeb2bcf228
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Compare and round more carefully
    
    * etc/NEWS: Document this.
    * src/data.c (store_symval_forwarding):
    * src/sound.c (parse_sound):
    Do not botch NaN comparison.
    * src/data.c (cons_to_unsigned, cons_to_signed):
    Signal an error if a floating-point arg is not integral.
    * src/data.c (cons_to_unsigned, cons_to_signed):
    * src/fileio.c (file_offset):
    Use simpler overflow check.
    * src/dbusbind.c (xd_extract_signed, xd_extract_unsigned):
    Avoid rounding error in overflow check.
    (Fcar_less_than_car): Use arithcompare directly.
    * test/src/charset-tests.el: New file.
---
 etc/NEWS                  |  5 +++++
 src/data.c                | 45 ++++++++++++++++++++++-----------------------
 src/dbusbind.c            |  4 ++--
 src/fileio.c              | 13 +++++++------
 src/sound.c               |  8 ++++----
 test/src/charset-tests.el | 26 ++++++++++++++++++++++++++
 6 files changed, 66 insertions(+), 35 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 9c99593..fe02236 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -915,6 +915,11 @@ Emacs integers with %e, %f, or %g conversions.  For 
example, on these
 hosts (eql N (string-to-number (format "%.0f" N))) now returns t for
 all Emacs integers N.
 
+---
+** Calls that accept floating-point integers (for use on hosts with
+limited integer range) now signal an error if arguments are not
+integral.  For example (decode-char 'ascii 0.5) now signals an error.
+
 +++
 ** The new function 'char-from-name' converts a Unicode name string
 to the corresponding character code.
diff --git a/src/data.c b/src/data.c
index 88d8669..66f4c9c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1110,10 +1110,8 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, 
register Lisp_Object newva
                else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
                  {
                    Lisp_Object min = XCAR (prop), max = XCDR (prop);
-
-                   if (!NUMBERP (newval)
-                       || !NILP (arithcompare (newval, min, ARITH_LESS))
-                       || !NILP (arithcompare (newval, max, ARITH_GRTR)))
+                   if (! NUMBERP (newval)
+                       || NILP (CALLN (Fleq, min, newval, max)))
                      wrong_range (min, max, newval);
                  }
                else if (FUNCTIONP (predicate))
@@ -2554,12 +2552,13 @@ uintbig_to_lisp (uintmax_t i)
 }
 
 /* Convert the cons-of-integers, integer, or float value C to an
-   unsigned value with maximum value MAX.  Signal an error if C does not
-   have a valid format or is out of range.  */
+   unsigned value with maximum value MAX, where MAX is one less than a
+   power of 2.  Signal an error if C does not have a valid format or
+   is out of range.  */
 uintmax_t
 cons_to_unsigned (Lisp_Object c, uintmax_t max)
 {
-  bool valid = 0;
+  bool valid = false;
   uintmax_t val;
   if (INTEGERP (c))
     {
@@ -2569,11 +2568,10 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
   else if (FLOATP (c))
     {
       double d = XFLOAT_DATA (c);
-      if (0 <= d
-         && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1))
+      if (0 <= d && d < 1.0 + max)
        {
          val = d;
-         valid = 1;
+         valid = val == d;
        }
     }
   else if (CONSP (c) && NATNUMP (XCAR (c)))
@@ -2587,7 +2585,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
        {
          uintmax_t mid = XFASTINT (XCAR (rest));
          val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
-         valid = 1;
+         valid = true;
        }
       else if (top <= UINTMAX_MAX >> 16)
        {
@@ -2596,37 +2594,38 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
          if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
            {
              val = top << 16 | XFASTINT (rest);
-             valid = 1;
+             valid = true;
            }
        }
     }
 
   if (! (valid && val <= max))
-    error ("Not an in-range integer, float, or cons of integers");
+    error ("Not an in-range integer, integral float, or cons of integers");
   return val;
 }
 
 /* Convert the cons-of-integers, integer, or float value C to a signed
-   value with extrema MIN and MAX.  Signal an error if C does not have
-   a valid format or is out of range.  */
+   value with extrema MIN and MAX.  MAX should be one less than a
+   power of 2, and MIN should be zero or the negative of a power of 2.
+   Signal an error if C does not have a valid format or is out of
+   range.  */
 intmax_t
 cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
 {
-  bool valid = 0;
+  bool valid = false;
   intmax_t val;
   if (INTEGERP (c))
     {
       val = XINT (c);
-      valid = 1;
+      valid = true;
     }
   else if (FLOATP (c))
     {
       double d = XFLOAT_DATA (c);
-      if (min <= d
-         && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1))
+      if (min <= d && d < 1.0 + max)
        {
          val = d;
-         valid = 1;
+         valid = val == d;
        }
     }
   else if (CONSP (c) && INTEGERP (XCAR (c)))
@@ -2640,7 +2639,7 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
        {
          intmax_t mid = XFASTINT (XCAR (rest));
          val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
-         valid = 1;
+         valid = true;
        }
       else if (INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16)
        {
@@ -2649,13 +2648,13 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t 
max)
          if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
            {
              val = top << 16 | XFASTINT (rest);
-             valid = 1;
+             valid = true;
            }
        }
     }
 
   if (! (valid && min <= val && val <= max))
-    error ("Not an in-range integer, float, or cons of integers");
+    error ("Not an in-range integer, integral float, or cons of integers");
   return val;
 }
 
diff --git a/src/dbusbind.c b/src/dbusbind.c
index e7c3251..d2460fd 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -526,7 +526,7 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
   else
     {
       double d = XFLOAT_DATA (x);
-      if (lo <= d && d <= hi)
+      if (lo <= d && d < 1.0 + hi)
        {
          intmax_t n = d;
          if (n == d)
@@ -554,7 +554,7 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
   else
     {
       double d = XFLOAT_DATA (x);
-      if (0 <= d && d <= hi)
+      if (0 <= d && d < 1.0 + hi)
        {
          uintmax_t n = d;
          if (n == d)
diff --git a/src/fileio.c b/src/fileio.c
index 3840062..acbf76e 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3426,11 +3426,12 @@ file_offset (Lisp_Object val)
   if (FLOATP (val))
     {
       double v = XFLOAT_DATA (val);
-      if (0 <= v
-         && (sizeof (off_t) < sizeof v
-             ? v <= TYPE_MAXIMUM (off_t)
-             : v < TYPE_MAXIMUM (off_t)))
-       return v;
+      if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t))
+       {
+         off_t o = v;
+         if (o == v)
+           return o;
+       }
     }
 
   wrong_type_argument (intern ("file-offset"), val);
@@ -5163,7 +5164,7 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, 
Scar_less_than_car, 2, 2, 0,
        doc: /* Return t if (car A) is numerically less than (car B).  */)
   (Lisp_Object a, Lisp_Object b)
 {
-  return CALLN (Flss, Fcar (a), Fcar (b));
+  return arithcompare (Fcar (a), Fcar (b), ARITH_LESS);
 }
 
 /* Build the complete list of annotations appropriate for writing out
diff --git a/src/sound.c b/src/sound.c
index 8475416..4714ac1 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -387,14 +387,14 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs)
     {
       if (INTEGERP (attrs[SOUND_VOLUME]))
        {
-         if (XINT (attrs[SOUND_VOLUME]) < 0
-             || XINT (attrs[SOUND_VOLUME]) > 100)
+         EMACS_INT volume = XINT (attrs[SOUND_VOLUME]);
+         if (! (0 <= volume && volume <= 100))
            return 0;
        }
       else if (FLOATP (attrs[SOUND_VOLUME]))
        {
-         if (XFLOAT_DATA (attrs[SOUND_VOLUME]) < 0
-             || XFLOAT_DATA (attrs[SOUND_VOLUME]) > 1)
+         double volume = XFLOAT_DATA (attrs[SOUND_VOLUME]);
+         if (! (0 <= volume && volume <= 1))
            return 0;
        }
       else
diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el
new file mode 100644
index 0000000..515a4ea
--- /dev/null
+++ b/test/src/charset-tests.el
@@ -0,0 +1,26 @@
+;;; charset-tests.el --- Tests for charset.c
+
+;; Copyright 2017 Free Software Foundation, Inc.
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest charset-decode-char ()
+  "Test decode-char."
+  (should-error (decode-char 'ascii 0.5)))
+
+(provide 'charset-tests)