bug#55356: join-thread unusable if timeout was hit

bug#55356: join-thread unusable if timeout was hit

[angry rectangle]

If join-thread is called after a previous call to join-thread hits the timeout, a "mutex already locked by thread" error is thrown.

Working example:

(use-modules (ice-9 threads))
(define t (call-with-new-thread
           (lambda _
             (let r ()
               (sleep 1)
               (r)))))
(join-thread t (current-time))
(join-thread t (current-time)) ;; exception here

my guile version: latest git. cc455976813ab94de121395982435430874cbf58
my OS: guix on amd64

bug#55356: [PATCH] Always release thread data mutex in join-thread.

[Olivier Dion via Bug reports for GUILE, GNU's Ubiquitous Extension Language]

From: Olivier Dion <olivier-dion@proton.me>

Currently the mutex is only unlocked when results are available.
However, it is not unlocked when we get a timeout from the condition
variable.

* module/ice-9/threads.scm (join-thread): Use with-mutex to ensure that
the thread data mutex is always unlocked.
---
 module/ice-9/threads.scm | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm
index c42bd266f..8993596e4 100644
--- a/module/ice-9/threads.scm
+++ b/module/ice-9/threads.scm
@@ -186,18 +186,17 @@ terminates, unless the target @var{thread} has already terminated."
   (match (thread-join-data thread)
     (#f (error "foreign thread cannot be joined" thread))
     ((cv . mutex)
-     (lock-mutex mutex)
-     (let lp ()
-       (cond
-        ((%thread-results cv)
-         => (lambda (results)
-              (unlock-mutex mutex)
-              (apply values results)))
-        ((if timeout
-             (wait-condition-variable cv mutex timeout)
-             (wait-condition-variable cv mutex))
-         (lp))
-        (else timeoutval))))))
+     (with-mutex mutex
+       (let lp ()
+         (cond
+          ((%thread-results cv)
+           => (lambda (results)
+                (apply values results)))
+          ((if timeout
+               (wait-condition-variable cv mutex timeout)
+               (wait-condition-variable cv mutex))
+           (lp))
+          (else timeoutval)))))))
 
 (define* (try-mutex mutex)
   "Try to lock @var{mutex}.  If the mutex is already locked, return
-- 
2.37.3