Extend use of the linkage table to static symbols

[sbcl.git] / contrib / sb-concurrency / tests / test-mailbox.lisp

diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp
index f69628a..d38459b 100644 (file)
--- a/contrib/sb-concurrency/tests/test-mailbox.lisp
+++ b/contrib/sb-concurrency/tests/test-mailbox.lisp
@@ -39,6 +39,30 @@
   (0 t nil t))
 
 #+sb-thread
+(deftest mailbox-timeouts
+    (let* ((mbox (make-mailbox))
+           (writers (loop for i from 1 upto 20
+                          collect (make-thread
+                                   (lambda (x)
+                                     (loop repeat 50
+                                           do (send-message mbox x)
+                                              (sleep 0.001)))
+                                   :arguments i)))
+           (readers (loop repeat 10
+                          collect (make-thread
+                                   (lambda ()
+                                     (loop while (receive-message mbox :timeout 0.1)
+                                           count t))))))
+      (mapc #'join-thread writers)
+      (apply #'+ (mapcar #'join-thread readers)))
+  1000)
+
+;;; FIXME: Several tests disabled on SunOS due to hangs.
+;;;
+;;; The issues don't seem to have anything to do with mailboxes
+;;; per-se, but are rather related to our usage of signal-unsafe
+;;; pthread functions inside signal handlers.
+#+(and sb-thread (not sunos))
 (progn
 
 ;; Dummy struct for ATOMIC-INCF to work.
@@ -146,8 +170,8 @@
 (deftest mailbox.single-producer-single-consumer
     (test-mailbox-producers-consumers :n-senders 1
                                       :n-receivers 1
-                                      :n-messages 10000)
-  (:received . 10000)
+                                      :n-messages 1000)
+  (:received . 1000)
   (:garbage  . 0)
   (:errors   . 0)
   (:timeouts . 0))
@@ -155,26 +179,26 @@
 (deftest mailbox.single-producer-multiple-consumers
     (test-mailbox-producers-consumers :n-senders 1
                                       :n-receivers 100
-                                      :n-messages 10000)
-  (:received . 10000)
+                                      :n-messages 1000)
+  (:received . 1000)
   (:garbage  . 0)
   (:errors   . 0)
   (:timeouts . 0))
 
 (deftest mailbox.multiple-producers-single-consumer
-    (test-mailbox-producers-consumers :n-senders 100
+    (test-mailbox-producers-consumers :n-senders 10
                                       :n-receivers 1
                                       :n-messages 100)
-  (:received . 10000)
+  (:received . 1000)
   (:garbage  . 0)
   (:errors   . 0)
   (:timeouts . 0))
 
 (deftest mailbox.multiple-producers-multiple-consumers
-    (test-mailbox-producers-consumers :n-senders 100
-                                      :n-receivers 100
-                                      :n-messages 10000)
-  (:received . 1000000)
+    (test-mailbox-producers-consumers :n-senders 50
+                                      :n-receivers 50
+                                      :n-messages 1000)
+  (:received . 50000)
   (:garbage  . 0)
   (:errors   . 0)
   (:timeouts . 0))
@@ -182,8 +206,8 @@
 (deftest mailbox.interrupts-safety.1
     (multiple-value-bind (received garbage errors timeouts)
         (test-mailbox-producers-consumers
-         :n-senders 100
-         :n-receivers 100
+         :n-senders 50
+         :n-receivers 50
          :n-messages 1000
          :interruptor #'(lambda (threads &aux (n (length threads)))
                           ;; 99 so even in the unlikely case that only
@@ -207,4 +231,4 @@
   (:garbage  . 0)
   (:timeouts . 0))
 
-) ; #+sb-thread (progn ...
\ No newline at end of file
+) ; #+sb-thread (progn ...