This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=21346c4f5e30910e3950c40bc267bb4249973240 The branch, master has been updated via 21346c4f5e30910e3950c40bc267bb4249973240 (commit) via 4201062de5e4f2eb7b2207a3c09e02a12b9bda50 (commit) from b579617b2db0e83f620c5b856dcc320cea9d6d1f (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 21346c4f5e30910e3950c40bc267bb4249973240 Author: Neil Jerram <n...@ossau.uklinux.net> Date: Wed May 20 21:55:35 2009 +0100 Remove possible deadlock in scm_join_thread_timed * libguile/threads.c (scm_join_thread_timed): Recheck t->exited before looping round to call block_self again, in case thread t has now exited. * test-suite/tests/threads.test ("don't hang when joined thread terminates in SCM_TICK"): New test. commit 4201062de5e4f2eb7b2207a3c09e02a12b9bda50 Author: Neil Jerram <n...@ossau.uklinux.net> Date: Sat May 23 17:55:58 2009 +0100 Fix wait-condition-variable so that it doesn't leave asyncs blocked * libguile/threads.c (fat_mutex_unlock): Unblock asyncs when breaking out of loop. * test-suite/tests/threads.test (asyncs-still-working?): New function, to test if asyncs are working (i.e. unblocked). Use this throughout threads.test, in particular before and after the "timed locking succeeds if mutex unlocked within timeout" test. ----------------------------------------------------------------------- Summary of changes: libguile/threads.c | 11 +++++++ test-suite/tests/threads.test | 67 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 76 insertions(+), 2 deletions(-) diff --git a/libguile/threads.c b/libguile/threads.c index bb874e2..d63c619 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -1161,6 +1161,16 @@ SCM_DEFINE (scm_join_thread_timed, "join-thread", 1, 2, 0, scm_i_pthread_mutex_unlock (&t->admin_mutex); SCM_TICK; scm_i_scm_pthread_mutex_lock (&t->admin_mutex); + + /* Check for exit again, since we just released and + reacquired the admin mutex, before the next block_self + call (which would block forever if t has already + exited). */ + if (t->exited) + { + res = t->result; + break; + } } } @@ -1491,6 +1501,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, { if (relock) scm_lock_mutex_timed (mutex, SCM_UNDEFINED, owner); + t->block_asyncs--; break; } diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index caace7f..6400d2d 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -21,6 +21,20 @@ :use-module (ice-9 threads) :use-module (test-suite lib)) +(define (asyncs-still-working?) + (let ((a #f)) + (system-async-mark (lambda () + (set! a #t))) + ;; The point of the following (equal? ...) is to go through + ;; primitive code (scm_equal_p) that includes a SCM_TICK call and + ;; hence gives system asyncs a chance to run. Of course the + ;; evaluator (eval.i.c) also calls SCM_TICK regularly, but in the + ;; near future we may be using the VM instead of the traditional + ;; compiler, and then we will still want asyncs-still-working? to + ;; work. (The VM should probably have SCM_TICK calls too, but + ;; let's not rely on that here.) + (equal? '(a b c) '(a b c)) + a)) (if (provided? 'threads) (begin @@ -101,6 +115,9 @@ (with-test-prefix "n-for-each-par-map" + (pass-if "asyncs are still working 2" + (asyncs-still-working?)) + (pass-if "0 in limit 10" (n-for-each-par-map 10 noop noop '()) #t) @@ -143,12 +160,18 @@ (with-test-prefix "lock-mutex" + (pass-if "asyncs are still working 3" + (asyncs-still-working?)) + (pass-if "timed locking fails if timeout exceeded" (let ((m (make-mutex))) (lock-mutex m) (let ((t (begin-thread (lock-mutex m (+ (current-time) 1))))) (not (join-thread t))))) + (pass-if "asyncs are still working 6" + (asyncs-still-working?)) + (pass-if "timed locking succeeds if mutex unlocked within timeout" (let* ((m (make-mutex)) (c (make-condition-variable)) @@ -164,7 +187,12 @@ (unlock-mutex cm) (sleep 1) (unlock-mutex m) - (join-thread t))))) + (join-thread t)))) + + (pass-if "asyncs are still working 7" + (asyncs-still-working?)) + + ) ;; ;; timed mutex unlocking @@ -172,12 +200,18 @@ (with-test-prefix "unlock-mutex" + (pass-if "asyncs are still working 5" + (asyncs-still-working?)) + (pass-if "timed unlocking returns #f if timeout exceeded" (let ((m (make-mutex)) (c (make-condition-variable))) (lock-mutex m) (not (unlock-mutex m c (current-time))))) + (pass-if "asyncs are still working 4" + (asyncs-still-working?)) + (pass-if "timed unlocking returns #t if condition signaled" (let ((m1 (make-mutex)) (m2 (make-mutex)) @@ -226,7 +260,36 @@ (pass-if "timed joining succeeds if thread exits within timeout" (let ((t (begin-thread (begin (sleep 1) #t)))) - (join-thread t (+ (current-time) 2))))) + (join-thread t (+ (current-time) 2)))) + + (pass-if "asyncs are still working 1" + (asyncs-still-working?)) + + ;; scm_join_thread_timed 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_timed 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)) ;; ;; thread cancellation hooks/post-receive -- GNU Guile
