Re: deadlock in scm_join_thread(_timed)

[Neil Jerram <neil@ossau.uklinux.net>]

[-- Attachment #1: Type: text/plain, Size: 658 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> Hello!
>
> Neil Jerram <neil@ossau.uklinux.net> writes:
>
>> Here is a proposed patch for branch_release-1-8.
>
> At first sight this looks good to me.

Thanks!  And here's the corresponding patch for master.  It's slightly
different, because scm_join_thread_timed in master allows for the join
attempt timing out and should return a special timeout value in that
case.  Also I had to fix another problem, wait-condition-variable
leaving asyncs blocked, before I could reproduce the
scm_join_thread_timed issue in threads.test, so a patch for that
problem is attached too.

Regards,
      Neil


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-wait-condition-variable-so-that-it-doesn-t-leave.patch --]
[-- Type: text/x-diff, Size: 3465 bytes --]

From a83a927bdbd6d5b971aa6f8172b78a2cdf34a5ef Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Sat, 23 May 2009 17:55:58 +0100
Subject: [PATCH] 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.
---
 libguile/threads.c            |    1 +
 test-suite/tests/threads.test |   35 +++++++++++++++++++++++++++++++++--
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/libguile/threads.c b/libguile/threads.c
index bb874e2..947e595 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1491,6 +1491,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..bd9f2f3 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -21,6 +21,12 @@
   :use-module (ice-9 threads)
   :use-module (test-suite lib))
 
+(define (asyncs-still-working?)
+  (let ((a #f))
+    (system-async-mark (lambda ()
+			 (set! a #t)))
+    (equal? '(a b c) '(a b c))
+    a))
 
 (if (provided? 'threads)
     (begin
@@ -101,6 +107,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 +152,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 +179,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 +192,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 +252,12 @@
 
 	(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?))
+
+	)
 
       ;;
       ;; thread cancellation
-- 
1.5.6.5


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Remove-possible-deadlock-in-scm_join_thread_timed.patch --]
[-- Type: text/x-diff, Size: 2789 bytes --]

From 01404cdfacabf49a7b834837bd3c2acebaefc591 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Wed, 20 May 2009 21:55:35 +0100
Subject: [PATCH] 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.
---
 libguile/threads.c            |   10 ++++++++++
 test-suite/tests/threads.test |   26 +++++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 1 deletions(-)

diff --git a/libguile/threads.c b/libguile/threads.c
index 947e595..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;
+	    }
 	}
     }
 
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index bd9f2f3..6d877b1 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -257,7 +257,31 @@
 	(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
-- 
1.5.6.5