X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-concurrency%2Ftests%2Ftest-mailbox.lisp;h=e6cee14bdd56d16b98fe70ece3782fa77983322f;hb=a00ea11a89c9db677e60edf6832c905a4527b5cb;hp=b93b34449e55c20f7b55aaea18208b22d4e511e1;hpb=b1f97e02b151845fd514e2fc254e69c1bd35ad48;p=sbcl.git

diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp
index b93b344..e6cee14 100644
--- a/contrib/sb-concurrency/tests/test-mailbox.lisp
+++ b/contrib/sb-concurrency/tests/test-mailbox.lisp
@@ -38,8 +38,30 @@
   (3 nil (#\1 #\2 #\3) nil)
   (0 t nil t))
 
-;;; FIXME: Several tests disabled on Darwin due to hangs. Something not right
-;;; with mailboxes -- or possibly semaphores -- there.
+#+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 Darwin and SunOS due to hangs.
+;;;
+;;; On Darwin at least 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 (or darwin sunos)))
 (progn