diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-02-16 15:14:09 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-02-16 15:29:35 +0100 |
| commit | 2c7b350f93564daee16a311c001a85577d4b69e1 (patch) | |
| tree | 056b7167cdd2b14fc8cd0fee3e2f57fae3bcbc22 /test-suite | |
| parent | 9417fdb80fb5db4f657c9a329faaa61162ab996b (diff) | |
srfi-18: When timeout is a number, it's a relative number of seconds.
Fixes <https://bugs.gnu.org/29704>.
Reported by David Beswick <dlbeswick@gmail.com>.
* module/srfi/srfi-18.scm (timeout->absolute-time): New procedure.
(mutex-lock!): Use it in 'thread:lock-mutex' call.
(mutex-unlock!): Use it.
* test-suite/tests/srfi-18.test ("mutex-lock! returns false on timeout")
("mutex-lock! returns true when lock obtained within timeout")
("recursive lock waits")
("mutex unlock is false when condition times out"): Adjust cases where
the 'timeout' parameter is a number so that it's a relative number.
Diffstat (limited to 'test-suite')
| -rw-r--r-- | test-suite/tests/srfi-18.test | 13 |
1 files changed, 5 insertions, 8 deletions
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test index a6e184c6f..fc36dab8a 100644 --- a/test-suite/tests/srfi-18.test +++ b/test-suite/tests/srfi-18.test @@ -1,7 +1,7 @@ ;;;; srfi-18.test --- Test suite for Guile's SRFI-18 functions. -*- scheme -*- ;;;; Julian Graham, 2007-10-26 ;;;; -;;;; Copyright (C) 2007, 2008, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2007, 2008, 2012, 2018 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -233,7 +233,7 @@ (pass-if "mutex-lock! returns false on timeout" (let* ((m (make-mutex 'mutex-lock-2)) - (t (make-thread (lambda () (mutex-lock! m (current-time) #f))))) + (t (make-thread (lambda () (mutex-lock! m 0 #f))))) (mutex-lock! m) (thread-start! t) (not (thread-join! t)))) @@ -241,9 +241,7 @@ (pass-if "mutex-lock! returns true when lock obtained within timeout" (let* ((m (make-mutex 'mutex-lock-3)) (t (make-thread (lambda () - (mutex-lock! m (+ (time->seconds (current-time)) - 100) - #f))))) + (mutex-lock! m 100 #f))))) (mutex-lock! m) (thread-start! t) (mutex-unlock! m) @@ -306,8 +304,7 @@ (let* ((m (make-mutex 'mutex-unlock-2)) (t (make-thread (lambda () (mutex-lock! m) - (let ((now (time->seconds (current-time)))) - (mutex-lock! m (+ now 0.1))) + (mutex-lock! m 0.1) (mutex-unlock! m)) 'mutex-unlock-2))) (thread-start! t) @@ -352,7 +349,7 @@ (let* ((m (make-mutex 'mutex-unlock-4)) (c (make-condition-variable 'mutex-unlock-4))) (mutex-lock! m) - (not (mutex-unlock! m c (+ (time->seconds (current-time)) 1)))))) + (not (mutex-unlock! m c 1))))) (with-test-prefix "condition-variable?" |