[Emacs-diffs] master f9fd12a: Fix time-add rounding bug

[Paul Eggert]

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

    Fix time-add rounding bug
    
    Without this fix, time arithmetic yielded results that were not
    mathematically accurate, even though the exact results were
    representable; for example, (time-add 0 1e-13) yielded a timestamp
    equal to 0 instead of to 1e-13.
    * lisp/timezone.el (timezone-time-from-absolute):
    Let time-add do its thing rather than using floating point
    internally, which has rounding errors.  We now have bignums and so
    don’t need floating point to avoid overflow issues.
    * src/timefns.c (timeform_sub_ps_p): New function.
    (time_arith): If either argument is a float, represent the
    result exactly instead of discarding sub-ps info.
    * test/lisp/timezone-tests.el (timezone-tests-time-from-absolute):
    Don’t assume (HI LO US PS) timestamp format.
    * test/src/emacs-module-tests.el (mod-test-add-nanosecond/valid):
    Don’t assume that time-add discards sub-ns info.
    * test/src/timefns-tests.el (time-rounding-tests):
    Add regression test to detect time-add rounding bug.
---
 lisp/timezone.el               |  4 ++--
 src/timefns.c                  | 14 +++++++++++---
 test/lisp/timezone-tests.el    |  7 ++++---
 test/src/emacs-module-tests.el |  7 +++++--
 test/src/timefns-tests.el      |  3 +++
 5 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/lisp/timezone.el b/lisp/timezone.el
index ff0b266..ce881a8 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -284,14 +284,14 @@ or an integer of the form +-HHMM, or a time zone name."
 
 (defun timezone-time-from-absolute (date seconds)
   "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
-Return a list suitable as an argument to `current-time-zone',
+Return a Lisp timestamp suitable as an argument to `current-time-zone',
 or nil if the date cannot be thus represented.
 DATE is the number of days elapsed since the (imaginary)
 Gregorian date Sunday, December 31, 1 BC."
   (let* ((current-time-origin 719163)
            ;; (timezone-absolute-from-gregorian 1 1 1970)
         (days (- date current-time-origin))
-        (seconds-per-day (float 86400))
+        (seconds-per-day 86400)
         (day-seconds (* days seconds-per-day)))
     (condition-case nil (time-add day-seconds seconds)
       (range-error))))
diff --git a/src/timefns.c b/src/timefns.c
index e9d1a9b..a4c1c4c 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -661,10 +661,18 @@ 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
@@ -1016,8 +1024,8 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool 
subtract)
 
 /* Given Lisp operands A and B, add their values, and return the
    result as a Lisp timestamp that is in (TICKS . HZ) form if either A
-   or B are in that form, (HI LO US PS) form otherwise.  Subtract
-   instead of adding if SUBTRACT.  */
+   or B are in that form or are floats, (HI LO US PS) form otherwise.
+   Subtract instead of adding if SUBTRACT.  */
 static Lisp_Object
 time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
 {
@@ -1077,7 +1085,7 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
      otherwise the (HI LO US PS) form for backward compatibility.  */
   return (EQ (hz, make_fixnum (1))
          ? ticks
-         : aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ
+         : timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform)
          ? Fcons (ticks, hz)
          : ticks_hz_list4 (ticks, hz));
 }
diff --git a/test/lisp/timezone-tests.el b/test/lisp/timezone-tests.el
index 4b5f561..c374042 100644
--- a/test/lisp/timezone-tests.el
+++ b/test/lisp/timezone-tests.el
@@ -135,9 +135,10 @@
   (should (equal (timezone-zone-to-minute "*invalid*") 0)))
 
 (ert-deftest timezone-tests-time-from-absolute ()
-  (should (equal (timezone-time-from-absolute (* 2020 365)  ; Jan 1 2020
-                                      (* 12 60 60)) ; 12:00
-                 '(23911 48704 0 0))))
+  (should (time-equal-p
+          (timezone-time-from-absolute (* 2020 365)  ; Jan 1 2020
+                                       (* 12 60 60)) ; 12:00
+          '(23911 48704 0 0))))
 
 ;; TODO: Write tests for timezone-tests-time-zone-from-absolute, which is a
 ;;       bit tricky since the results depend on `current-time-zone'.
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index c44c386..c510784 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -335,12 +335,15 @@ Interactively, you can try hitting \\[keyboard-quit] to 
quit."
                   ;; New (TICKS . HZ) format.
                   '(123456789 . 1000000000)))
     (ert-info ((format "input: %s" input))
-      (let ((result (mod-test-add-nanosecond input)))
+      (let ((result (mod-test-add-nanosecond input))
+           (desired-result
+            (let ((hz 1000000000))
+              (time-add (time-convert input hz) (cons 1 hz)))))
         (should (consp result))
         (should (integerp (car result)))
         (should (integerp (cdr result)))
         (should (cl-plusp (cdr result)))
-        (should (time-equal-p result (time-add input '(0 0 0 1000))))))))
+        (should (time-equal-p result desired-result))))))
 
 (ert-deftest mod-test-add-nanosecond/nil ()
   (should (<= (float-time (mod-test-add-nanosecond nil))
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 1b1032d..362e765 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -145,6 +145,9 @@
                      (< 0.99 (/ (- (float-time a)) (float-time b))
                         1.01))))))))
 
+(ert-deftest time-rounding-tests ()
+  (should (time-equal-p 1e-13 (time-add 0 1e-13))))
+
 (ert-deftest encode-time-dst-numeric-zone ()
     "Check for Bug#35502."
     (should (time-equal-p