From 3c40b133e7464dfd4eb9e2c7c1d2a1e8e2b47096 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Wed, 19 Dec 2018 17:01:09 +0100 Subject: [PATCH 1/2] Add test cases raising issues wrt. force-primordial. --- tests/mutex-test.scm | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/tests/mutex-test.scm b/tests/mutex-test.scm index 035d7092..ee7c2de1 100644 --- a/tests/mutex-test.scm +++ b/tests/mutex-test.scm @@ -177,6 +177,54 @@ Slot Type Meaning (print "Got " mux " state " (mutex-state mux) " expected " (current-thread) "\n") (test-exit 1)) +(let* ((job (lambda () + (do ((i 1 (add1 i))) + ((= i 10) i) + (##sys#force-primordial) + (thread-yield!)))) + (t (thread-start! job)) + (r (thread-join! t))) + (when (not (equal? r 10)) + (print "Forcing primordial broke thread-join! result: " r) + (test-exit 1))) + +(let* ((mux (make-mutex 'done)) + (job (lambda () + (do ((i 1 (add1 i))) + ((= i 10) + (mutex-specific-set! mux i) + (mutex-unlock! mux)) + (##sys#force-primordial) + (thread-yield!)))) + (t (begin + (mutex-lock! mux) + (thread-start! job))) + (r (mutex-lock! mux))) + (when (not (and (eq? r #t) + (equal? (mutex-specific mux) 10))) + (print "Forcing primordial broke mutex-lock! result: " r (mutex-specific mux)) + (test-exit 1))) + +(let* ((mux (make-mutex 'done)) + (cv (make-condition-variable)) + (job (lambda () + (do ((i 1 (add1 i))) + ((= i 10) + (mutex-lock! mux) + (mutex-specific-set! mux i) + (condition-variable-signal! cv) + (mutex-unlock! mux)) + (##sys#force-primordial) + (thread-yield!)))) + (t (begin + (mutex-lock! mux) + (thread-start! job))) + (r (mutex-unlock! mux cv))) + (when (not (and (eq? r #t) + (equal? (mutex-specific mux) 10))) + (print "Forcing primordial broke mutex-unlock! result: " r (mutex-specific mux)) + (test-exit 1))) + (cond-expand (dribble (define-for-syntax count 0) (define-syntax trail -- 2.11.0