1.0.27.30: minor octets.lisp cleanup

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

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 31341c6..11b39cf 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -43,28 +43,30 @@
     mutex))
 
 (sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
-    void)
+    void
+  (where sb-alien:unsigned-long))
 (sb-alien:define-alien-routine "check_deferrables_unblocked_or_lose"
-    void)
+    void
+  (where sb-alien:unsigned-long))
 
 (with-test (:name (:interrupt-thread :deferrables-blocked))
   (sb-thread:interrupt-thread sb-thread:*current-thread*
                               (lambda ()
-                                (check-deferrables-blocked-or-lose))))
+                                (check-deferrables-blocked-or-lose 0))))
 
 (with-test (:name (:interrupt-thread :deferrables-unblocked))
   (sb-thread:interrupt-thread sb-thread:*current-thread*
                               (lambda ()
                                 (with-interrupts
-                                  (check-deferrables-unblocked-or-lose)))))
+                                  (check-deferrables-unblocked-or-lose 0)))))
 
 (with-test (:name (:interrupt-thread :nlx))
   (catch 'xxx
     (sb-thread:interrupt-thread sb-thread:*current-thread*
                                 (lambda ()
-                                  (check-deferrables-blocked-or-lose)
+                                  (check-deferrables-blocked-or-lose 0)
                                   (throw 'xxx nil))))
-  (check-deferrables-unblocked-or-lose))
+  (check-deferrables-unblocked-or-lose 0))
 
 #-sb-thread (sb-ext:quit :unix-status 104)
 
@@ -75,9 +77,9 @@
     (sb-thread::get-spinlock spinlock)
     (sb-thread:interrupt-thread thread
                                 (lambda ()
-                                  (check-deferrables-blocked-or-lose)
+                                  (check-deferrables-blocked-or-lose 0)
                                   (sb-thread::get-spinlock spinlock)
-                                  (check-deferrables-unblocked-or-lose)
+                                  (check-deferrables-unblocked-or-lose 0)
                                   (sb-ext:quit)))
     (sleep 1)
     (sb-thread::release-spinlock spinlock)))
@@ -871,6 +873,31 @@
 |     (mp:make-process #'roomy)))
 |#
 
+;;; KLUDGE: No deadlines while waiting on lutex-based condition variables. This test
+;;; would just hang.
+#-sb-lutex
+(with-test (:name (:condition-variable :wait-multiple))
+  (loop repeat 40 do
+        (let ((waitqueue (sb-thread:make-waitqueue :name "Q"))
+              (mutex (sb-thread:make-mutex :name "M"))
+              (failedp nil))
+          (format t ".")
+          (finish-output t)
+          (let ((threads (loop repeat 200
+                               collect
+                               (sb-thread:make-thread
+                                (lambda ()
+                                  (handler-case
+                                      (sb-sys:with-deadline (:seconds 0.01)
+                                        (sb-thread:with-mutex (mutex)
+                                          (sb-thread:condition-wait waitqueue
+                                                                    mutex)
+                                          (setq failedp t)))
+                                    (sb-sys:deadline-timeout (c)
+                                      (declare (ignore c)))))))))
+            (mapc #'sb-thread:join-thread threads)
+            (assert (not failedp))))))
+
 (with-test (:name (:condition-variable :notify-multiple))
   (flet ((tester (notify-fun)
            (let ((queue (make-waitqueue :name "queue"))