mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Remove possible deadlock in scm_join_thread

Browse source 
* libguile/threads.c (scm_join_thread): Always recheck t->exited
  before calling block_self again, in case thread t has now exited.

* test-suite/tests/threads.test (joining): New test.
This commit is contained in:
Neil Jerram 2009-05-20 21:55:35 +01:00
parent 3ed47d2203
commit 66f3b6c1b0
2 changed files with 40 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/threads.c
View file

@ -934,9 +934,7 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
t = SCM_I_THREAD_DATA (thread);
if (!t->exited)
{
while (1)
while (!t->exited)
{
block_self (t->join_queue, thread, &thread_admin_mutex, NULL);
if (t->exited)
@ -945,7 +943,6 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
SCM_TICK;
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
}
}
res = t->result;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);

34
test-suite/tests/threads.test
View file

@ -133,4 +133,36 @@
(lambda (n) (set! result (cons n result)))
(lambda (n) (* 2 n))
'(0 1 2 3 4 5))
(equal? result '(10 8 6 4 2 0)))))))
(equal? result '(10 8 6 4 2 0)))))
;;
;; thread joining
;;
(with-test-prefix "joining"
;; scm_join_thread has a SCM_TICK in the middle of it, to
;; allow asyncs to run (including signal delivery). We used
;; to have a bug whereby if the joined thread terminated at
;; the same time as the joining thread is in this SCM_TICK,
;; scm_join_thread would not notice and would hang forever.
;; So in this test we are setting up the following sequence of
;; events.
;; T=0 other thread is created and starts running
;; T=2 main thread sets up an async that will sleep for 10 seconds
;; T=2 main thread calls join-thread, which will...
;; T=2 ...call the async, which starts sleeping
;; T=5 other thread finishes its work and terminates
;; T=7 async completes, main thread continues inside join-thread.
(pass-if "don't hang when joined thread terminates in SCM_TICK"
(let ((other-thread (make-thread sleep 5)))
(letrec ((delay-count 10)
(aproc (lambda ()
(set! delay-count (- delay-count 1))
(if (zero? delay-count)
(sleep 5)
(system-async-mark aproc)))))
(sleep 2)
(system-async-mark aproc)
(join-thread other-thread)))
#t))))