From 7288c18082a6334be0548e2e23ca13921f99076f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Tue, 18 Dec 2018 14:26:03 +0100 Subject: [PATCH 2/4] Add test case catching #1564 almost for sure. --- tests/mutex-test.scm | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/mutex-test.scm b/tests/mutex-test.scm index 873e812c..738e73d3 100644 --- a/tests/mutex-test.scm +++ b/tests/mutex-test.scm @@ -55,6 +55,29 @@ Slot Type Meaning (print "Got " mux1 " state " (mutex-state mux1) " expected " owner1 "\n") (test-exit 1))))) +(let ((m1 (make-mutex))) + ;; This fails if we manage to sort primorial before t1 and unleash + ;; both in one turn. + (define (sys-thread-sleep! limit) + ;; a copy from srfi-18 which expects pre-computed goal time. + (##sys#call-with-current-continuation + (lambda (return) + (let ((ct ##sys#current-thread)) + (##sys#setslot ct 1 (lambda () (return (##core#undefined)))) + (##sys#thread-block-for-timeout! ct limit) + (##sys#schedule) ) ) ) ) + #;(print "mutex state changes atomically wrt. blocking queues") + (mutex-lock! m1) + (let ((t1 (thread-start! (lambda () (mutex-lock! m1 0.1))))) + #;(print "have t1 it wait for m1") + (thread-yield!) + (let* ((to (##sys#slot t1 4)) + (hit (- to 0.0001))) + #;(print "waiting ever so slightly less than to " to " i.e. " hit "\n") + (sys-thread-sleep! hit)) + ;; catch inconsistent state + (mutex-unlock! m1))) + (set! mux1 (make-mutex 'unlock-leaves-no-memory-leak)) (mutex-lock! mux1) (mutex-unlock! mux1) -- 2.11.0