mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 16:51:06 -07:00
Code Issues Projects Releases Wiki Activity

Avoid some excess precision in time arithmetic

Browse source 
* doc/misc/emacs-mime.texi (time-date):
Adjust example to match new behavior.
* etc/NEWS: Mention this.
* lisp/calendar/time-date.el (decoded-time-add)
(decoded-time--alter-second):
Don’t lose underestimate precision of seconds component.
* src/bignum.c (mpz): Grow by 1.
* src/timefns.c (trillion_factor): New function.
(timeform_sub_ps_p): Remove.
(time_arith): Avoid unnecessarily-large hz, by reducing the hz
to a value no worse than the worse hz of the two arguments.
The result is always exact unless an error is signaled.
* test/src/timefns-tests.el (timefns-tests--decode-time):
New function.
(format-time-string-with-zone): Test (decode-time LOOK ZONE t)
resolution as well as its numeric value.
This commit is contained in:
Paul Eggert 2019-08-20 17:34:03 -07:00
parent 7e2090ee80
commit 396ed88a50
7 changed files with 134 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

2
doc/misc/emacs-mime.texi
View file

@ -1568,7 +1568,7 @@ Here's a bunch of time/date/second/day examples:
(time-subtract '(905595714000000 . 1000000)
'(905595593000000000 . 1000000000))
@result{} (121000000000 . 1000000000)
@result{} (121000000 . 1000000)
(days-between "Sat Sep 12 12:21:54 1998 +0200"
"Sat Sep 07 12:21:54 1998 +0200")

4
etc/NEWS
View file

@ -2166,7 +2166,9 @@ end and duration).
+++
*** 'time-add', 'time-subtract', and 'time-less-p' now accept
infinities and NaNs too, and propagate them or return nil like
floating-point operators do.
floating-point operators do. If both arguments are finite, these
functions now return exact results instead of rounding in some cases,
and they also avoid excess precision when that is easy.
+++
*** New function 'time-equal-p' compares time values for equality.

32
lisp/calendar/time-date.el
View file

@ -421,10 +421,13 @@ changes in daylight saving time are not taken into account."
;; Do the time part, which is pretty simple (except for leap
;; seconds, I guess).
;; Time zone adjustments are basically the same as time adjustments.
(setq seconds (time-add (+ (* (or (decoded-time-hour delta) 0) 3600)
(* (or (decoded-time-minute delta) 0) 60)
(or (decoded-time-zone delta) 0))
(or (decoded-time-second delta) 0)))
(setq seconds (time-convert (or (decoded-time-second delta) 0) t))
(setq seconds
(time-add seconds
(time-convert (+ (* (or (decoded-time-hour delta) 0) 3600)
(* (or (decoded-time-minute delta) 0) 60)
(or (decoded-time-zone delta) 0))
(cdr seconds))))
(decoded-time--alter-second time seconds)
time))
@ -461,11 +464,16 @@ changes in daylight saving time are not taken into account."
(defun decoded-time--alter-second (time seconds)
"Increase the time in TIME by SECONDS."
(let* ((secsperday 86400)
(old (time-add (+ (* 3600 (or (decoded-time-hour time) 0))
(* 60 (or (decoded-time-minute time) 0)))
(or (decoded-time-second time) 0)))
(new (time-add old seconds)))
(let* ((time-sec (time-convert (or (decoded-time-second time) 0) t))
(time-hz (cdr time-sec))
(old (time-add time-sec
(time-convert
(+ (* 3600 (or (decoded-time-hour time) 0))
(* 60 (or (decoded-time-minute time) 0)))
time-hz)))
(new (time-convert (time-add old seconds) t))
(new-hz (cdr new))
(secsperday (time-convert 86400 new-hz)))
;; Hm... DST...
(while (time-less-p new 0)
(decoded-time--alter-day time nil)
@ -474,8 +482,10 @@ changes in daylight saving time are not taken into account."
(decoded-time--alter-day time t)
(setq new (time-subtract new secsperday)))
(let ((sec (time-convert new 'integer)))
(setf (decoded-time-second time) (time-add (% sec 60)
(time-subtract new sec))
(setf (decoded-time-second time) (time-add
(time-convert (% sec 60) new-hz)
(time-subtract
new (time-convert sec new-hz)))
(decoded-time-minute time) (% (/ sec 60) 60)
(decoded-time-hour time) (/ sec 3600)))))

5
src/bignum.c
View file

@ -31,9 +31,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
storage is exhausted. Admittedly this is not ideal. An mpz value
in a temporary is made permanent by mpz_swapping it with a bignum's
value. Although typically at most two temporaries are needed,
time_arith, rounddiv_q and rounding_driver each need four. */
rounddiv_q and rounding_driver both need four and time_arith needs
five. */
mpz_t mpz[4];
mpz_t mpz[5];
static void *
xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)

2
src/bignum.h
View file

@ -41,7 +41,7 @@ struct Lisp_Bignum
mpz_t value;
} GCALIGNED_STRUCT;
extern mpz_t mpz[4];
extern mpz_t mpz[5];
extern void init_bignum (void);
extern Lisp_Object make_integer_mpz (void);

104
src/timefns.c
View file

@ -99,6 +99,22 @@ mpz_t ztrillion;
# endif
#endif
/* True if the nonzero Lisp integer HZ divides evenly into a trillion. */
static bool
trillion_factor (Lisp_Object hz)
{
if (FASTER_TIMEFNS)
{
if (FIXNUMP (hz))
return TRILLION % XFIXNUM (hz) == 0;
if (!FIXNUM_OVERFLOW_P (TRILLION))
return false;
}
verify (TRILLION <= INTMAX_MAX);
intmax_t ihz;
return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
}
/* Return a struct timeval that is roughly equivalent to T.
Use the least timeval not less than T.
Return an extremal value if the result would overflow. */
@ -681,18 +697,10 @@ enum timeform
TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
TIMEFORM_NIL, /* current time in nanoseconds */
TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
/* These two should be last; see timeform_sub_ps_p. */
TIMEFORM_FLOAT, /* time as a float */
TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
};
/* True if Lisp times of form FORM can express sub-picosecond timestamps. */
static bool
timeform_sub_ps_p (enum timeform form)
{
return TIMEFORM_FLOAT <= form;
}
/* From the valid form FORM and the time components HIGH, LOW, USEC
and PSEC, generate the corresponding time value. If LOW is
floating point, the other components should be zero and FORM should
@ -1080,9 +1088,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
else
{
/* The plan is to decompose ta into na/da and tb into nb/db.
Start by computing da and db. */
Start by computing da and db, their minimum (which will be
needed later) and the iticks temporary that will become
available once only their minimum is needed. */
mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
bool da_lt_db = mpz_cmp (*da, *db) < 0;
mpz_t const *hzmin = da_lt_db ? da : db;
mpz_t *iticks = &mpz[da_lt_db + 1];
/* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
where g = gcd (da, db). Start by computing g. */
@ -1090,34 +1103,83 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
mpz_gcd (*g, *da, *db);
/* fa = da/g, fb = db/g. */
mpz_t *fa = &mpz[1], *fb = &mpz[3];
mpz_t *fa = &mpz[4], *fb = &mpz[3];
mpz_tdiv_q (*fa, *da, *g);
mpz_tdiv_q (*fb, *db, *g);
/* FIXME: Maybe omit need for extra temp by computing fa * db here? */
/* ihz = fa * db. This is equal to lcm (da, db). */
mpz_t *ihz = &mpz[0];
mpz_mul (*ihz, *fa, *db);
/* hz = fa * db. This is equal to lcm (da, db). */
mpz_mul (mpz[0], *fa, *db);
hz = make_integer_mpz ();
/* When warning about obsolete timestamps, if the smaller
denominator comes from a non-(TICKS . HZ) timestamp and could
generate a (TICKS . HZ) timestamp that would look obsolete,
arrange for the result to have a higher HZ to avoid a
spurious warning by a later consumer of this function's
returned value. */
verify (1 << LO_TIME_BITS <= ULONG_MAX);
if (WARN_OBSOLETE_TIMESTAMPS
&& (da_lt_db ? aform : bform) == TIMEFORM_FLOAT
&& (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ
&& mpz_cmp_ui (*hzmin, 1) > 0
&& mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0)
{
mpz_t *hzmin1 = &mpz[2 - da_lt_db];
mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS);
hzmin = hzmin1;
}
/* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
OP is the multiply-add or multiply-sub form of OPER. */
mpz_t const *na = bignum_integer (&mpz[0], ta.ticks);
mpz_mul (mpz[0], *fb, *na);
/* iticks = (fb * na) OP (fa * nb), where OP is + or -. */
mpz_t const *na = bignum_integer (iticks, ta.ticks);
mpz_mul (*iticks, *fb, *na);
mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
(subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
(subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
/* Normalize iticks/ihz by dividing both numerator and
denominator by ig = gcd (iticks, ihz). However, if that
would cause the denominator to become less than hzmin,
rescale the denominator upwards from its ordinary value by
multiplying numerator and denominator so that the denominator
becomes at least hzmin. This rescaling avoids returning a
timestamp that is less precise than both a and b, or a
timestamp that looks obsolete when that might be a problem. */
mpz_t *ig = &mpz[3];
mpz_gcd (*ig, *iticks, *ihz);
if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
{
mpz_tdiv_q (*iticks, *iticks, *ig);
mpz_tdiv_q (*ihz, *ihz, *ig);
if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
{
/* Rescale straightforwardly. Although this might not
yield the minimal denominator that preserves numeric
value and is at least hzmin, calculating such a
denominator would be too expensive because it would
require testing multisets of factors of lcm (da, db). */
mpz_t *rescale = &mpz[3];
mpz_cdiv_q (*rescale, *hzmin, *ihz);
mpz_mul (*iticks, *iticks, *rescale);
mpz_mul (*ihz, *ihz, *rescale);
}
}
hz = make_integer_mpz ();
mpz_swap (mpz[0], *iticks);
ticks = make_integer_mpz ();
}
/* Return an integer if the timestamp resolution is 1,
otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if
either input form supports timestamps that cannot be expressed
either input used (TICKS . HZ) form or the result can't be expressed
exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
for backward compatibility. */
return (EQ (hz, make_fixnum (1))
? ticks
: (!CURRENT_TIME_LIST
|| timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform))
|| aform == TIMEFORM_TICKS_HZ
|| bform == TIMEFORM_TICKS_HZ
|| !trillion_factor (hz))
? Fcons (ticks, hz)
: ticks_hz_list4 (ticks, hz));
}

44
test/src/timefns-tests.el
View file

@ -19,6 +19,12 @@
(require 'ert)
(defun timefns-tests--decode-time (look zone decoded-time)
(should (equal (decode-time look zone t) decoded-time))
(should (equal (decode-time look zone 'integer)
(cons (time-convert (car decoded-time) 'integer)
(cdr decoded-time)))))
;;; Check format-time-string and decode-time with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
@ -40,31 +46,29 @@
(7879679999900 . 100000)
(78796799999999999999 . 1000000000000)))
;; UTC.
(let ((sec (time-add 59 (time-subtract (time-convert look t)
(time-convert look 'integer)))))
(let* ((look-ticks-hz (time-convert look t))
(hz (cdr look-ticks-hz))
(look-integer (time-convert look 'integer))
(sec (time-add (time-convert 59 hz)
(time-subtract look-ticks-hz
(time-convert look-integer hz)))))
(should (string-equal
(format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
"1972-06-30 23:59:59.999 +0000"))
(should (equal (decode-time look t 'integer)
'(59 59 23 30 6 1972 5 nil 0)))
(should (equal (decode-time look t t)
(list sec 59 23 30 6 1972 5 nil 0)))
(timefns-tests--decode-time look t
(list sec 59 23 30 6 1972 5 nil 0))
;; "UTC0".
(should (string-equal
(format-time-string format look "UTC0")
"1972-06-30 23:59:59.999 +0000 (UTC)"))
(should (equal (decode-time look "UTC0" 'integer)
'(59 59 23 30 6 1972 5 nil 0)))
(should (equal (decode-time look "UTC0" t)
(list sec 59 23 30 6 1972 5 nil 0)))
(timefns-tests--decode-time look "UTC0"
(list sec 59 23 30 6 1972 5 nil 0))
;; Negative UTC offset, as a Lisp list.
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
(should (equal (decode-time look '(-28800 "PST") 'integer)
'(59 59 15 30 6 1972 5 nil -28800)))
(should (equal (decode-time look '(-28800 "PST") t)
(list sec 59 15 30 6 1972 5 nil -28800)))
(timefns-tests--decode-time look '(-28800 "PST")
(list sec 59 15 30 6 1972 5 nil -28800))
;; Negative UTC offset, as a Lisp integer.
(should (string-equal
(format-time-string format look -28800)
@ -73,18 +77,14 @@
(if (eq system-type 'windows-nt)
"1972-06-30 15:59:59.999 -0800 (ZZZ)"
"1972-06-30 15:59:59.999 -0800 (-08)")))
(should (equal (decode-time look -28800 'integer)
'(59 59 15 30 6 1972 5 nil -28800)))
(should (equal (decode-time look -28800 t)
(list sec 59 15 30 6 1972 5 nil -28800)))
(timefns-tests--decode-time look -28800
(list sec 59 15 30 6 1972 5 nil -28800))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
"1972-07-01 05:29:59.999 +0530 (IST)"))
(should (equal (decode-time look "IST-5:30" 'integer)
'(59 29 5 1 7 1972 6 nil 19800)))
(should (equal (decode-time look "IST-5:30" t)
(list sec 29 5 1 7 1972 6 nil 19800)))))))
(timefns-tests--decode-time look "IST-5:30"
(list sec 29 5 1 7 1972 6 nil 19800))))))
(ert-deftest decode-then-encode-time ()
(let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0