From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 13 Apr 2012 11:00:21 +0000 (+0300)
Subject: robustify (deadlock-detection interrupts) test
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8d7b58dabde9733600ef9176d2b6c6aef5013aea;p=sbcl.git

robustify (deadlock-detection interrupts) test

    1. Make sure the desired "tricky" ordering happens.
    2. Make sure threads can't exit before they're intrerupted.

  Next time I commit a test that relies on SLEEP without a comment explaining
  (1) why it is necessary and there isn't a better alternative (2) what the
  ordering the tests is trying to achieve actually ise... please hit me with a
  stick. Hard.
---

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 8bd9f19..546ce5c 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -1355,32 +1355,36 @@
 (with-test (:name (:deadlock-detection :interrupts))
   (let* ((m1 (sb-thread:make-mutex :name "M1"))
          (m2 (sb-thread:make-mutex :name "M2"))
+         (t1-can-go (sb-thread:make-semaphore :name "T1 can go"))
+         (t2-can-go (sb-thread:make-semaphore :name "T2 can go"))
          (t1 (sb-thread:make-thread
               (lambda ()
                 (sb-thread:with-mutex (m1)
-                  (sleep 0.3)
-                  :ok))
+                  (sb-thread:wait-on-semaphore t1-can-go)
+                  :ok1))
               :name "T1"))
          (t2 (sb-thread:make-thread
               (lambda ()
-                (sleep 0.1)
+                (sb-ext:wait-for (eq t1 (sb-thread:mutex-owner m1)))
                 (sb-thread:with-mutex (m1 :wait-p t)
-                  (sleep 0.2)
-                  :ok))
+                  (sb-thread:wait-on-semaphore t2-can-go)
+                  :ok2))
               :name "T2")))
-    (sleep 0.2)
+    (sb-ext:wait-for (eq m1 (sb-thread::thread-waiting-for t2)))
     (sb-thread:interrupt-thread t2 (lambda ()
                                      (sb-thread:with-mutex (m2 :wait-p t)
-                                       (sleep 0.3))))
-    (sleep 0.05)
+                                       (sb-ext:wait-for
+                                        (eq m2 (sb-thread::thread-waiting-for t1)))
+                                       (sb-thread:signal-semaphore t2-can-go))))
+    (sb-ext:wait-for (eq t2 (sb-thread:mutex-owner m2)))
     (sb-thread:interrupt-thread t1 (lambda ()
                                      (sb-thread:with-mutex (m2 :wait-p t)
-                                       (sleep 0.3))))
+                                       (sb-thread:signal-semaphore t1-can-go))))
     ;; both threads should finish without a deadlock or deadlock
     ;; detection error
     (let ((res (list (sb-thread:join-thread t1)
                      (sb-thread:join-thread t2))))
-      (assert (equal '(:ok :ok) res)))))
+      (assert (equal '(:ok1 :ok2) res)))))
 
 (with-test (:name (:deadlock-detection :gc))
   ;; To semi-reliably trigger the error (in SBCL's where)