Improve rounding in recent timer fix

* lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time):
Use more-precise arithmetic to handle some boundary cases better
when rounding errors occur (Bug#33071).
* test/lisp/emacs-lisp/timer-tests.el:
(timer-next-integral-multiple-of-time-3):
New test, to test one of the boundary cases.
(timer-next-integral-multiple-of-time-2):
Redo so as to not assume a particular way of rounding 0.01.

diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index e140738d9f31ef13eae649b3e0b4fe1d126f1967..56323c85c2cab73658b1bef8d377eb24047129fb 100644 (file)
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -100,10 +100,16 @@ of SECS seconds since the epoch.  SECS may be a fraction."
                            (integerp (cdr time)) (< 0 (cdr time)))
                       time
                     (encode-time time 1000000000000)))
+        (ticks (car ticks-hz))
         (hz (cdr ticks-hz))
-        (s-ticks (round (* secs hz)))
-        (more-ticks (+ (car ticks-hz) s-ticks)))
-    (encode-time (cons (- more-ticks (% more-ticks s-ticks)) hz))))
+        trunc-s-ticks)
+    (while (let ((s-ticks (* secs hz)))
+            (setq trunc-s-ticks (truncate s-ticks))
+            (/= s-ticks trunc-s-ticks))
+      (setq ticks (ash ticks 1))
+      (setq hz (ash hz 1)))
+    (let ((more-ticks (+ ticks trunc-s-ticks)))
+      (encode-time (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz)))))
 
 (defun timer-relative-time (time secs &optional usecs psecs)
   "Advance TIME by SECS seconds and optionally USECS microseconds

diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index 7a5b9263b0bc93b1622366c2264969bc94682587..e463b9e98bdb4d8d466da218969c7616b8dce31a 100644 (file)
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -47,9 +47,21 @@
 (ert-deftest timer-next-integral-multiple-of-time-2 ()
   "Test bug#33071."
   (let* ((tc (current-time))
-         (tce (encode-time tc 100))
-         (nt (timer-next-integral-multiple-of-time tc 0.01))
-         (nte (encode-time nt 100)))
-    (should (= (car nte) (1+ (car tce))))))
+         (delta-ticks 1000)
+         (hz 128000)
+         (tce (encode-time tc hz))
+         (tc+delta (time-add tce (cons delta-ticks hz)))
+         (tc+deltae (encode-time tc+delta hz))
+         (tc+delta-ticks (car tc+deltae))
+         (tc-nexte (cons (- tc+delta-ticks (% tc+delta-ticks delta-ticks)) hz))
+         (nt (timer-next-integral-multiple-of-time
+              tc (/ (float delta-ticks) hz)))
+         (nte (encode-time nt hz)))
+    (should (equal tc-nexte nte))))
+
+(ert-deftest timer-next-integral-multiple-of-time-3 ()
+  "Test bug#33071."
+  (let ((nt (timer-next-integral-multiple-of-time '(32770 . 65539) 0.5)))
+    (should (time-equal-p 1 nt))))
 
 ;;; timer-tests.el ends here