(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))
(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
(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))))
+
+(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))))))))