procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve rounding in recent timer fix

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2018-10-22 19:31:15 -07:00 • committed by Paul Eggert
parent 8602bd8559
commit a381285617
2 changed files with 25 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lisp/emacs-lisp/timer.el
View file

@ -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

20
test/lisp/emacs-lisp/timer-tests.el
View file

@ -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