Unlock mutex even when condition variable timeout is hit
Add tests
Relevant srfi-18 documentation:
https://srfi.schemers.org/srfi-18/srfi-18.html
NOTE: mutex-unlock! is related to the "wait" operation on condition variables available
in other thread systems. The main difference is that "wait" automatically locks mutex
just after the thread is unblocked. This operation is not performed by mutex-unlock! and so must be
done by an explicit call to mutex-lock!.
From 15dbf3b7ee27b3a4706528a55a68bd956945fddb Mon Sep 17 00:00:00 2001
From: nathan <nathan_m...@nborghese.com>
Date: Mon, 31 Mar 2025 11:55:53 -0400
Subject: [PATCH] srfi-18: Unlock mutex even when condition variable timeout is
hit
* module/srfi/srfi-18.scm (mutex-unlock!): Unlock mutex even when
condition variable timeout is hit
* test-suite/tests/srfi-18.test: Add code to test if mutex is unlocked
after waiting on condition variable
---
module/srfi/srfi-18.scm | 12 +++++++-----
test-suite/tests/srfi-18.test | 21 ++++++++++++++++++++-
2 files changed, 27 insertions(+), 6 deletions(-)
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 79aedb8d1..1c7cb1160 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -315,11 +315,13 @@ object (absolute point in time), or #f."
(threads:wait-condition-variable (condition-variable-prim cond-var)
(mutex-prim mutex))
(threads:unlock-mutex (mutex-prim mutex)))
- ((threads:wait-condition-variable (condition-variable-prim cond-var)
- (mutex-prim mutex)
- timeout)
- (threads:unlock-mutex (mutex-prim mutex)))
- (else #f)))))
+ (else
+ (let ((result (threads:wait-condition-variable
+ (condition-variable-prim cond-var)
+ (mutex-prim mutex)
+ timeout)))
+ (threads:unlock-mutex (mutex-prim mutex))
+ result))))))
;; CONDITION VARIABLES
;; These functions are all pass-thrus to the existing Guile implementations.
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test
index f46543d98..01e2aad96 100644
--- a/test-suite/tests/srfi-18.test
+++ b/test-suite/tests/srfi-18.test
@@ -348,7 +348,26 @@
(let* ((m (make-mutex 'mutex-unlock-4))
(c (make-condition-variable 'mutex-unlock-4)))
(mutex-lock! m)
- (not (mutex-unlock! m c 1)))))
+ (not (mutex-unlock! m c 1))))
+
+ (pass-if "mutex is still unlocked after condition variable is signaled"
+ (let* ((m (make-mutex 'condition-variable-signal-1))
+ (c (make-condition-variable 'condition-variable-signal-1))
+ (t (make-thread (lambda ()
+ (mutex-lock! m)
+ (condition-variable-signal! c)
+ (mutex-unlock! m)))))
+ (mutex-lock! m)
+ (thread-start! t)
+ (mutex-unlock! m c)
+ (eqv? (mutex-state m) 'not-abandoned)))
+
+ (pass-if "mutex is still unlocked after condition variable timeout"
+ (let* ((m (make-mutex 'condition-variable-signal-1))
+ (c (make-condition-variable 'condition-variable-signal-1)))
+ (mutex-lock! m)
+ (mutex-unlock! m c 1)
+ (eqv? (mutex-state m) 'not-abandoned))))
(with-test-prefix "condition-variable?"
--
2.49.0
