From 29712ead5765d5c4486a70179291e8a96e263742 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Mon, 3 Jan 2022 22:58:46 -0500 Subject: [PATCH] Add test that condition-wait reacquires the lock on timeout --- apiv1/default-implementations.lisp | 15 +++++---------- apiv1/impl-ecl.lisp | 4 +++- apiv2/api-condition-variables.lisp | 10 +++++----- apiv2/api-locks.lisp | 7 ++++--- apiv2/impl-ecl.lisp | 4 +++- bordeaux-threads.asd | 4 +++- test/tests-v2.lisp | 39 ++++++++++++++++++++++++++++++++++---- 7 files changed, 58 insertions(+), 25 deletions(-) diff --git a/apiv1/default-implementations.lisp b/apiv1/default-implementations.lisp index 3927d04..6463a69 100644 --- a/apiv1/default-implementations.lisp +++ b/apiv1/default-implementations.lisp @@ -235,20 +235,15 @@ WITH-LOCK-HELD etc etc" It is an error to call function this unless from the thread that holds LOCK. - If TIMEOUT is nil or not provided, the system always reacquires LOCK - before returning to the caller. In this case T is returned. + If TIMEOUT is nil or not provided, the call blocks until a + notification is received. If TIMEOUT is non-nil, the call will return after at most TIMEOUT seconds (approximately), whether or not a notification has occurred. + Either NIL or T will be returned. A return of NIL indicates that the - lock is no longer held and that the timeout has expired. A return of - T indicates that the lock is held, in which case the timeout may or - may not have expired. - - **NOTE**: The behavior of CONDITION-WAIT with TIMEOUT diverges from - the POSIX function pthread_cond_timedwait. The former may return - without the lock being held while the latter always returns with the - lock held. + timeout has expired without receiving a notification. A return of T + indicates that a notification was received. In an implementation that does not support multiple threads, this function signals an error." diff --git a/apiv1/impl-ecl.lisp b/apiv1/impl-ecl.lisp index 424ce93..369614a 100644 --- a/apiv1/impl-ecl.lisp +++ b/apiv1/impl-ecl.lisp @@ -76,7 +76,9 @@ Distributed under the MIT license (see LICENSE file) (if timeout (handler-case (with-timeout (timeout) (mp:condition-variable-wait condition-variable lock)) - (timeout () nil)) + (timeout () + (acquire-lock lock) + nil)) (mp:condition-variable-wait condition-variable lock))) (defun condition-notify (condition-variable) diff --git a/apiv2/api-condition-variables.lisp b/apiv2/api-condition-variables.lisp index 5ec852b..5f2adf0 100644 --- a/apiv2/api-condition-variables.lisp +++ b/apiv2/api-condition-variables.lisp @@ -62,15 +62,15 @@ It is an error to call this function unless from the thread that holds LOCK. - If TIMEOUT is nil or not provided, the system always reacquires LOCK - before returning to the caller. In this case T is returned. + If TIMEOUT is nil or not provided, the call blocks until a + notification is received. If TIMEOUT is non-nil, the call will return after at most TIMEOUT seconds (approximately), whether or not a notification has occurred. + Either NIL or T will be returned. A return of NIL indicates that the - lock is no longer held and that the timeout has expired. A return of - T indicates that the lock is held, in which case the timeout may or - may not have expired." + timeout has expired without receiving a notification. A return of T + indicates that a notification was received." (check-type timeout (or null (real 0))) (%condition-wait condition-variable (lock-native-lock lock) diff --git a/apiv2/api-locks.lisp b/apiv2/api-locks.lisp index 53a3efa..eeb25e3 100644 --- a/apiv2/api-locks.lisp +++ b/apiv2/api-locks.lisp @@ -98,6 +98,7 @@ (defun make-recursive-lock (&key name) "Create and return a recursive lock whose name is NAME. + A recursive lock differs from an ordinary lock in that a thread that already holds the recursive lock can acquire it again without blocking. The thread must then release the lock twice before it @@ -111,9 +112,9 @@ (defun acquire-recursive-lock (lock &key (wait t) timeout) "Acquire the lock LOCK for the calling thread. - WAIT governs what happens if the lock is not available: if WAIT - is true, the calling thread will wait until the lock is available - and then acquire it; if WAIT is NIL, ACQUIRE-LOCK will return + WAIT governs what happens if the lock is not available: if WAIT is + true, the calling thread will wait until the lock is available and + then acquire it; if WAIT is NIL, ACQUIRE-RECURSIVE-LOCK will return immediately. If WAIT is true, TIMEOUT may specify a maximum amount of seconds to diff --git a/apiv2/impl-ecl.lisp b/apiv2/impl-ecl.lisp index 2f5e335..3a32ff6 100644 --- a/apiv2/impl-ecl.lisp +++ b/apiv2/impl-ecl.lisp @@ -134,7 +134,9 @@ (handler-case (with-timeout (timeout) (mp:condition-variable-wait cv lock)) - (timeout () nil)) + (timeout () + (%acquire-lock lock t nil) + nil)) (mp:condition-variable-wait cv lock))) (defun %condition-notify (cv) diff --git a/bordeaux-threads.asd b/bordeaux-threads.asd index a3c6a04..da0655a 100644 --- a/bordeaux-threads.asd +++ b/bordeaux-threads.asd @@ -104,4 +104,6 @@ (:file "pkgdcl") (:file "not-implemented") (:file "tests-v2")) - :perform (test-op (o c) (symbol-call :5am :run! :bordeaux-threads-2))) + :perform (test-op (o c) + (symbol-call :5am :run! :bordeaux-threads) + (symbol-call :5am :run! :bordeaux-threads-2))) diff --git a/test/tests-v2.lisp b/test/tests-v2.lisp index 0ea85ab..0be19ab 100644 --- a/test/tests-v2.lisp +++ b/test/tests-v2.lisp @@ -365,10 +365,41 @@ the only cause that can wake a waiter." (flag nil)) (make-thread (lambda () (sleep 0.4) (setf flag t))) (with-lock-held (lock) - (condition-wait cv lock :timeout 0.2) - (is (null flag)) - (sleep 0.4) - (is (eq t flag))))) + (let ((success + (condition-wait cv lock :timeout 0.2))) + #+abcl + (skip "ABCL's condition-wait always returns T") + #-abcl + (is-false success) + (is (null flag)) + (sleep 0.4) + (is (eq t flag)))))) + +#+#.(bt2::implemented-p* 'bt2:condition-wait :timeout) +(test condition-wait.lock-held-on-timeout + "Tests that even when `CONDITION-WAIT` times out, it reacquires the +lock." + (let ((lock (make-lock :name "Test lock")) + (cv (make-condition-variable :name "Test condition variable"))) + (with-lock-held (lock) + (let ((success + (condition-wait cv lock :timeout 2))) + #+abcl + (skip "ABCL's condition-wait always returns T") + #-abcl + (is-false success) + ;; We need to test if `lock` is locked, but it must be done in + ;; another thread, otherwise it would be a recursive attempt. + (let ((res-lock (make-lock :name "Result lock")) + (res-cv (make-condition-variable :name "Result condition variable")) + (lock-was-acquired-p nil)) + (make-thread (lambda () + (with-lock-held (res-lock) + (setf lock-was-acquired-p (acquire-lock lock :wait nil))) + (condition-notify res-cv))) + (with-lock-held (res-lock) + (condition-wait res-cv res-lock) + (is-false lock-was-acquired-p))))))) ;;; -- 2.11.4.GIT