X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftimer.impure.lisp;h=a2028b8aaa55a2f0deccba799d7281a55f96634a;hb=1fca8fbb946ba06cedf777c3a6927f14d24cfae5;hp=45b7025e051d5570ea5e2f98ba9fb334c4e8da71;hpb=8d10dd337a91dc2f53cbd0e8e68b0e49238deaa3;p=sbcl.git

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 45b7025..a2028b8 100644
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -13,6 +13,10 @@
 
 (use-package :test-util)
 
+(defmacro raises-timeout-p (&body body)
+  `(handler-case (progn (progn ,@body) nil)
+    (sb-ext:timeout () t)))
+
 (with-test (:name (:timer :relative))
   (let* ((has-run-p nil)
          (timer (make-timer (lambda () (setq has-run-p t))
@@ -84,10 +88,6 @@
     (sleep 2)
     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
 
-(defmacro raises-timeout-p (&body body)
-  `(handler-case (progn (progn ,@body) nil)
-    (sb-ext:timeout () t)))
-
 (with-test (:name (:with-timeout :timeout))
   (assert (raises-timeout-p
            (sb-ext:with-timeout 0.2
@@ -110,10 +110,54 @@
             (sb-ext:with-timeout 2
               (sleep 2))))))
 
+(defun wait-for-threads (threads)
+  (loop while (some #'sb-thread:thread-alive-p threads) do (sleep 0.01)))
+
+#+sb-thread
 (with-test (:name (:with-timeout :many-at-the-same-time))
-  (loop repeat 10 do
-        (sb-thread:make-thread
-         (lambda ()
-           (sb-ext:with-timeout 0.5
-             (sleep 5)
-             (assert nil))))))
+  (let ((ok t))
+    (let ((threads (loop repeat 10 collect
+                         (sb-thread:make-thread
+                          (lambda ()
+                            (handler-case
+                                (sb-ext:with-timeout 0.5
+                                  (sleep 5)
+                                  (setf ok nil)
+                                  (format t "~%not ok~%"))
+                              (timeout ()
+                                )))))))
+      (assert (not (raises-timeout-p
+                    (sb-ext:with-timeout 20
+                      (wait-for-threads threads)))))
+      (assert ok))))
+
+#+sb-thread
+(with-test (:name (:with-timeout :dead-thread))
+  (sb-thread:make-thread
+   (lambda ()
+     (let ((timer (make-timer (lambda ()))))
+       (schedule-timer timer 3)
+       (assert t))))
+  (sleep 6)
+  (assert t))
+
+
+(defun random-type (n)
+  `(integer ,(random n) ,(+ n (random n))))
+
+;;; FIXME: Since timeouts do not work on Windows this would loop
+;;; forever.
+#-win32
+(with-test (:name '(:hash-cache :interrupt))
+  (let* ((type1 (random-type 500))
+         (type2 (random-type 500))
+         (wanted (subtypep type1 type2)))
+    (dotimes (i 100)
+      (block foo
+        (sb-ext:schedule-timer (sb-ext:make-timer
+                                (lambda ()
+                                  (assert (eq wanted (subtypep type1 type2)))
+                                    (return-from foo)))
+                               0.05)
+        (loop
+           (assert (eq wanted (subtypep type1 type2))))))))