From 3d161d4d2fcfb7d0bb044d0f2231770a944ab65c Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 13 Oct 2012 23:51:55 +0900 Subject: [PATCH] If we are re-awakened waiting on a thread-join! but without timing out, try to join again to make sure it's really dead. --- lib/srfi/18/interface.scm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lib/srfi/18/interface.scm b/lib/srfi/18/interface.scm index c83cd5fb..d95522ee 100644 --- a/lib/srfi/18/interface.scm +++ b/lib/srfi/18/interface.scm @@ -22,18 +22,19 @@ (define (thread-join! thread . o) (let ((timeout (and (pair? o) (car o)))) - (cond - ((%thread-join! thread (timeout->seconds timeout)) - (thread-result thread)) - (else - (thread-yield!) + (let lp () (cond - ((and timeout (thread-timeout?)) - (if (and (pair? o) (pair? (cdr o))) - (cadr o) - (error "timed out waiting for thread" thread))) + ((%thread-join! thread (timeout->seconds timeout)) + (thread-result thread)) (else - (thread-result thread))))))) + (thread-yield!) + (cond + ((and timeout (thread-timeout?)) + (if (and (pair? o) (pair? (cdr o))) + (cadr o) + (error "timed out waiting for thread" thread))) + (else + (lp)))))))) (define (thread-terminate! thread) (if (%thread-terminate! thread) ;; need to yield if terminating ourself