Skip to content
This repository has been archived by the owner on Apr 18, 2022. It is now read-only.

Commit

Permalink
Improve rounding in recent timer fix
Browse files Browse the repository at this point in the history
* 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.
  • Loading branch information
Paul Eggert authored and eggert committed Oct 23, 2018
1 parent 8602bd8 commit a381285
Show file tree
Hide file tree
Showing 2 changed files with 25 additions and 7 deletions.
12 changes: 9 additions & 3 deletions lisp/emacs-lisp/timer.el
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
20 changes: 16 additions & 4 deletions test/lisp/emacs-lisp/timer-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -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

0 comments on commit a381285

Please sign in to comment.