robustify (deadlock-detection interrupts) test

[sbcl.git] / tests / threads.impure.lisp

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 75bb628..546ce5c 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -528,8 +528,7 @@
 
 (defun alloc-stuff () (copy-list '(1 2 3 4 5)))
 
-(with-test (:name (:interrupt-thread :interrupt-consing-child)
-            :broken-on :darwin)
+(with-test (:name (:interrupt-thread :interrupt-consing-child))
   (let ((thread (sb-thread:make-thread (lambda () (loop (alloc-stuff))))))
     (let ((killers
            (loop repeat 4 collect
@@ -1042,8 +1041,7 @@
 ;;; Make sure that a deadline handler is not invoked twice in a row in
 ;;; CONDITION-WAIT. See LP #512914 for a detailed explanation.
 ;;;
-(with-test (:name (:condition-wait :deadlines :LP-512914)
-            :skipped-on '(not :sb-futex))
+(with-test (:name (:condition-wait :deadlines :LP-512914))
   (let ((n 2)                      ; was empirically enough to trigger the bug
         (mutex (sb-thread:make-mutex))
         (waitq (sb-thread:make-waitqueue))
@@ -1193,9 +1191,7 @@
 
 (format t "~&starting gc deadlock test: WARNING: THIS TEST WILL HANG ON FAILURE!~%")
 
-(with-test (:name :gc-deadlock
-                  ;; Prone to hang on Darwin due to interrupt issues.
-            :broken-on :darwin)
+(with-test (:name :gc-deadlock)
   ;; Prior to 0.9.16.46 thread exit potentially deadlocked the
   ;; GC due to *all-threads-lock* and session lock. On earlier
   ;; versions and at least on one specific box this test is good enough
@@ -1359,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)
@@ -1407,3 +1407,26 @@
     (let ((res (list (sb-thread:join-thread t1)
                      (sb-thread:join-thread t2))))
       (assert (equal '(:ok :ok) res)))))
+
+(with-test (:name :spinlock-api)
+  (let* ((warned 0)
+         (funs
+           (handler-bind ((sb-int:early-deprecation-warning (lambda (_)
+                                                              (declare (ignore _))
+                                                              (incf warned))))
+             (list (compile nil `(lambda (lock)
+                                   (sb-thread::with-spinlock (lock)
+                                     t)))
+                   (compile nil `(lambda ()
+                                   (sb-thread::make-spinlock :name "foo")))
+                   (compile nil `(lambda (lock)
+                                   (sb-thread::get-spinlock lock)))
+                   (compile nil `(lambda (lock)
+                                   (sb-thread::release-spinlock lock)))))))
+    (assert (eql 4 warned))
+    (handler-bind ((warning #'error))
+      (destructuring-bind (with make get release) funs
+        (let ((lock (funcall make)))
+          (funcall get lock)
+          (funcall release lock)
+          (assert (eq t (funcall with lock))))))))