[Guile-commits] 15/24: Recursively locking a SRFI-18 mutex blocks

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f1f68fffb159d390a21e98dae364b1a425e33eb4
Author: Andy Wingo <address@hidden>
Date:   Sat Nov 5 10:08:01 2016 +0100

    Recursively locking a SRFI-18 mutex blocks
    
    * libguile/threads.c (fat_mutex_lock): allow-external-unlock mutexes
      can't be recursive, but a recursive lock attempt can be unblocked by
      an external thread, so these mutexes shouldn't throw an error on
      recursive lock attempts.
    * test-suite/tests/srfi-18.test: Add tests.
---
 libguile/threads.c            |    2 +-
 test-suite/tests/srfi-18.test |   35 +++++++++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/libguile/threads.c b/libguile/threads.c
index 6263519..b62c163 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1152,7 +1152,7 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, int 
*ret)
          *ret = 1;
          break;
        }
-      else if (scm_is_eq (m->owner, new_owner))
+      else if (scm_is_eq (m->owner, new_owner) && !m->allow_external_unlock)
        {
          if (m->recursive)
            {
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test
index ddd72db..a6e184c 100644
--- a/test-suite/tests/srfi-18.test
+++ b/test-suite/tests/srfi-18.test
@@ -302,6 +302,41 @@
         (thread-join! t)
         (eq? (mutex-state m) 'not-abandoned)))
 
+    (pass-if "recursive lock waits"
+      (let* ((m (make-mutex 'mutex-unlock-2))
+             (t (make-thread (lambda ()
+                               (mutex-lock! m)
+                               (let ((now (time->seconds (current-time))))
+                                 (mutex-lock! m (+ now 0.1)))
+                               (mutex-unlock! m))
+                             'mutex-unlock-2)))
+        (thread-start! t)
+        (thread-join! t)
+        (eq? (mutex-state m) 'not-abandoned)))
+
+    (pass-if "recursive lock unblocked by second thread"
+      (let* ((m1 (make-mutex))
+             (m2 (make-mutex))
+             (c (make-condition-variable)))
+        (mutex-lock! m1)
+        (let ((t (make-thread (lambda ()
+                                (mutex-lock! m1)
+                                (mutex-lock! m2)
+                                (condition-variable-signal! c)
+                                (mutex-unlock! m1)
+                                (mutex-lock! m2)
+                                (mutex-unlock! m2)))))
+          (thread-start! t)
+          (mutex-unlock! m1 c)
+          ;; At this point the thread signalled that it has both m1 and
+          ;; m2, and it will go to try to lock m2 again.  We wait for it
+          ;; to block trying to acquire m2 by sleeping a little bit and
+          ;; then unblock it by unlocking m2 from here.
+          (usleep #e1e5)
+          (mutex-unlock! m2)
+          (thread-join! t)
+          (eq? (mutex-state m2) 'not-abandoned))))
+
     (pass-if "mutex unlock is true when condition is signalled"
       (let* ((m (make-mutex 'mutex-unlock-3))
              (c (make-condition-variable 'mutex-unlock-3))