From a38128561757c82fbd088cba379b7a253558c7f1 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 22 Oct 2018 19:31:15 -0700 Subject: [PATCH] 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. --- lisp/emacs-lisp/timer.el | 12 +++++++++--- test/lisp/emacs-lisp/timer-tests.el | 20 ++++++++++++++++---- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index e140738d9f31..56323c85c2ca 100644 --- 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 7a5b9263b0bc..e463b9e98bdb 100644 --- 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