diff options
| -rw-r--r-- | module/srfi/srfi-18.scm | 2 | ||||
| -rw-r--r-- | test-suite/tests/srfi-18.test | 8 |
2 files changed, 8 insertions, 2 deletions
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm index 5b5b2a686..01550c310 100644 --- a/module/srfi/srfi-18.scm +++ b/module/srfi/srfi-18.scm @@ -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*)) diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test index 47f8f7f40..ab055132e 100644 --- a/test-suite/tests/srfi-18.test +++ b/test-suite/tests/srfi-18.test @@ -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)))))
\ No newline at end of file + success))))) |