diff --git a/NEWS b/NEWS index 57fc6f776..0bfbd1dd8 100644 --- a/NEWS +++ b/NEWS @@ -37,6 +37,8 @@ the compiler reports it as "possibly unused". () ** Avoid module resolution in 'call-with-new-thread', which could deadlock () +** Fix deadlock in 'join-thread' when timeout is hit + () ** 'read-u8' in (scheme base) now defaults to (current-input-port) () ** Hashing of UTF-8 symbols with non-ASCII characters avoids corruption diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm index 048d8b085..a1e43b9fa 100644 --- a/module/ice-9/threads.scm +++ b/module/ice-9/threads.scm @@ -204,7 +204,9 @@ terminates, unless the target @var{thread} has already terminated." (wait-condition-variable cv mutex timeout) (wait-condition-variable cv mutex)) (lp)) - (else timeoutval)))))) + (else + (unlock-mutex mutex) + timeoutval)))))) (define* (try-mutex mutex) "Try to lock @var{mutex}. If the mutex is already locked, return diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index efdf36db2..fa89deeb2 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -332,7 +332,21 @@ (sleep 2) (system-async-mark aproc) (join-thread other-thread))) - #t)) + #t) + + (pass-if "do not throw exception if trying to join after timeout" + (let ((other-thread (begin-thread (pause)))) + (dynamic-wind + (const #f) + (lambda () + (join-thread other-thread 1) + ;; Up to 3.0.9, this second call would throw: "mutex + ;; already locked by thread". + ;; See . + (join-thread other-thread 1) + #t) + (lambda () + (cancel-thread other-thread)))))) ;; ;; thread cancellation