mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 12:20:26 +02:00
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.
This commit is contained in:
parent
b43f11469a
commit
f1f68fffb1
2 changed files with 36 additions and 1 deletions
|
@ -1152,7 +1152,7 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, int *ret)
|
||||||
*ret = 1;
|
*ret = 1;
|
||||||
break;
|
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)
|
if (m->recursive)
|
||||||
{
|
{
|
||||||
|
|
|
@ -302,6 +302,41 @@
|
||||||
(thread-join! t)
|
(thread-join! t)
|
||||||
(eq? (mutex-state m) 'not-abandoned)))
|
(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"
|
(pass-if "mutex unlock is true when condition is signalled"
|
||||||
(let* ((m (make-mutex 'mutex-unlock-3))
|
(let* ((m (make-mutex 'mutex-unlock-3))
|
||||||
(c (make-condition-variable 'mutex-unlock-3))
|
(c (make-condition-variable 'mutex-unlock-3))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue