1.0.5.29: fix a race-condition in deadline.impure.lisp
[sbcl.git] / tests / deadline.impure.lisp
1 (defmacro assert-timeout (form)
2   (let ((ok (gensym "OK")))
3     `(let ((,ok ',ok))
4        (unless (eq ,ok
5                    (handler-case ,form
6                      (timeout ()
7                        ,ok)))
8          (error "No timeout from form:~%  ~S" ',form)))))
9
10
11 (assert-timeout
12  (sb-impl::with-deadline (:seconds 1)
13    (run-program "sleep" '("5") :search t :wait t)))
14
15 #+(and sb-thread (not sb-lutex))
16 (progn
17   (assert-timeout
18    (let ((lock (sb-thread:make-mutex))
19          (waitp t))
20      (sb-thread:make-thread (lambda ()
21                               (sb-thread:get-mutex lock)
22                               (setf waitp nil)
23                               (sleep 5)))
24      (loop while waitp do (sleep 0.01))
25      (sb-impl::with-deadline (:seconds 1)
26        (sb-thread:get-mutex lock))))
27
28   (assert-timeout
29    (let ((sem (sb-thread::make-semaphore :count 0)))
30      (sb-impl::with-deadline (:seconds 1)
31        (sb-thread::wait-on-semaphore sem))))
32
33   (assert-timeout
34    (sb-impl::with-deadline (:seconds 1)
35      (sb-thread:join-thread
36       (sb-thread:make-thread (lambda () (loop (sleep 1))))))))