mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Calculate usecs correctly in thread-sleep!

Browse source 
* module/srfi/srfi-18.scm (thread-sleep!): Correctly compute
  microseconds.

* test-suite/tests/srfi-18.test: Add test.
This commit is contained in:
Nathaniel Alderson 2013-09-19 14:02:26 -07:00 • committed by Andy Wingo
parent 972fb41f0c
commit 8d124d2077
2 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/srfi/srfi-18.scm
View file

@ -236,7 +236,7 @@
(list timeout)
'()))))
(secs (inexact->exact (truncate t)))
(usecs (inexact->exact (truncate (* (- t secs) 1000)))))
(usecs (inexact->exact (truncate (* (- t secs) 1000000)))))
(and (> secs 0) (sleep secs))
(and (> usecs 0) (usleep usecs))
*unspecified*))

8
test-suite/tests/srfi-18.test
View file

@ -96,6 +96,12 @@
(let ((old-secs (car (current-time))))
(unspecified? (thread-sleep! (+ (time->seconds (current-time)))))))
(pass-if "thread sleeps fractions of a second"
(let* ((current (time->seconds (current-time)))
(future (+ current 0.5)))
(thread-sleep! future)
(>= (time->seconds (current-time)) future)))
(pass-if "thread does not sleep on past time"
(let ((past-time (seconds->time (- (time->seconds (current-time)) 2))))
(unspecified? (thread-sleep! past-time)))))
@ -479,4 +485,4 @@
(eq? (uncaught-exception-reason obj) 'foo)
(set! success #t)))
(lambda () (thread-join! t)))
success)))))
success)))))