>From 6ac6565c6add2dbbd18dc6ee30fd062ba4349fd9 Mon Sep 17 00:00:00 2001 From: Nathaniel Alderson Date: Thu, 19 Sep 2013 14:02:26 -0700 Subject: [PATCH] calculate usecs correctly in thread-sleep! --- module/srfi/srfi-18.scm | 4 ++-- test-suite/tests/srfi-18.test | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm index 684a125..c394aef 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*)) @@ -380,4 +380,4 @@ (cons (inexact->exact fx) (inexact->exact (truncate (* (- x fx) 1000000))))))) -;; srfi-18.scm ends here \ No newline at end of file +;; srfi-18.scm ends here diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test index 47f8f7f..ab05513 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))))) -- 1.8.1.4