X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-concurrency%2Ftests%2Ftest-mailbox.lisp;h=88d3975bc2faffffb0139e11085d6124bc09a8b5;hb=6548750bc1ca4d832afed1744cdc7133b232c6f2;hp=5243446ee2466b96f1d45fc343ea371106697394;hpb=8e3fdbded85d5b9e7687a06846ebea5d4686b7e2;p=sbcl.git diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp index 5243446..88d3975 100644 --- a/contrib/sb-concurrency/tests/test-mailbox.lisp +++ b/contrib/sb-concurrency/tests/test-mailbox.lisp @@ -38,9 +38,31 @@ (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. -#+(and sb-thread (not darwin)) +#+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. @@ -209,4 +231,4 @@ (:garbage . 0) (:timeouts . 0)) -) ; #+sb-thread (progn ... \ No newline at end of file +) ; #+sb-thread (progn ...