From aae2f95d0452ce7908eb281bbde90b22b8329429 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Tue, 18 Dec 2018 15:46:46 +0100 Subject: [PATCH 3/4] Add test case for properly abondons of mutexs. --- tests/mutex-test.scm | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/tests/mutex-test.scm b/tests/mutex-test.scm index 738e73d3..035d7092 100644 --- a/tests/mutex-test.scm +++ b/tests/mutex-test.scm @@ -86,6 +86,27 @@ Slot Type Meaning (test-error "thread still held in mutex after unlock: " mux1)) ;;============ +(let* ((cv (make-condition-variable)) + (m (begin + (condition-variable-specific-set! cv #f) + (make-mutex))) + (t (thread-start! + (lambda () + (do () + ((condition-variable-specific cv)) + (mutex-unlock! m cv)))))) + (thread-yield!) + (when + (not (eq? (##sys#slot t 3) 'sleeping)) + (test-error "thread not sleeping " t)) + (condition-variable-specific-set! cv #t) + (condition-variable-signal! cv) + (thread-yield!) + (when + (not (eq? (##sys#slot t 3) 'dead)) + (test-error "thread not completed " t))) + +;;============ ; Make a locked mutex (define mux (make-mutex 'foo)) (mutex-lock! mux #f #f) @@ -131,6 +152,23 @@ Slot Type Meaning (print "Abandoned Mutex not abandoned " mux "\n") (test-exit 1)) +(unless (eq? (mutex-state mux) (current-thread)) + (print "Mutex " mux " locked/not-owned but left in state " (mutex-state mux) "\n") + (test-exit 1)) + +;; repeat with owned mutex +(set! mux (make-mutex 'foobar)) +(thread-start! (lambda () (mutex-lock! mux))) +(thread-yield!) + +(when (not (handle-exceptions ex (abandoned-mutex-exception? ex) (and (mutex-lock! mux) #f))) + (print "Abandoned Mutex not abandoned " mux "\n") + (test-exit 1)) + +(unless (eq? (mutex-state mux) (current-thread)) + (print "Mutex " mux " not assigned to " (current-thread) " but left in state " (mutex-state mux) "\n") + (test-exit 1)) + (mutex-unlock! mux) (mutex-lock! mux) -- 2.11.0