diff options
author | Andy Wingo <wingo@pobox.com> | 2016-11-05 10:08:01 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-11-05 10:30:54 +0100 |
commit | f1f68fffb159d390a21e98dae364b1a425e33eb4 (patch) | |
tree | 0d4850053404c3f77fe584e8d15eb6b2edc502e9 | |
parent | b43f11469a859324d74fd9b7142b0f86e2f05d16 (diff) | |
download | guile-f1f68fffb159d390a21e98dae364b1a425e33eb4.tar.gz |
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.
-rw-r--r-- | libguile/threads.c | 2 | ||||
-rw-r--r-- | test-suite/tests/srfi-18.test | 35 |
2 files changed, 36 insertions, 1 deletions
diff --git a/libguile/threads.c b/libguile/threads.c index 6263519a0..b62c1639a 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 ddd72dbab..a6e184c6f 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)) |