diff options
| author | Nathaniel Alderson <alderson@gmail.com> | 2013-09-19 14:02:26 -0700 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2014-03-23 21:58:54 +0100 |
| commit | 8d124d207738be0b43dfc235a5d72519a2ab5db9 (patch) | |
| tree | b606507b1f7f0edd918ad55dc60ea30b739b1a97 | |
| parent | 972fb41f0ce124d97f5cf64bde1075510cd21e18 (diff) | |
| download | guile-8d124d207738be0b43dfc235a5d72519a2ab5db9.tar.gz | |
Calculate usecs correctly in thread-sleep!
* module/srfi/srfi-18.scm (thread-sleep!): Correctly compute
microseconds.
* test-suite/tests/srfi-18.test: Add test.
| -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))))) |