procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare and round more carefully

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2017-03-04 23:14:52 -08:00
parent 44e7ee2e35
commit 0d55c44a9a
6 changed files with 66 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
etc/NEWS
View file

@ -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.

45
src/data.c
View file

@ -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;
}

4
src/dbusbind.c
View file

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

13
src/fileio.c
View file

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

8
src/sound.c
View file

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

26
test/src/charset-tests.el Normal file
View file

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