3 (use-package :test-util)
5 (defmacro assert-timeout (form)
6 (let ((ok (gensym "OK")))
12 (error "No timeout from form:~% ~S" ',form)))))
14 (defun run-sleep (seconds)
15 (sb-ext:run-program "sleep" (list (format nil "~D" seconds))
18 (with-test (:name (:deadline :run-program :trivial))
19 (assert-timeout (sb-sys:with-deadline (:seconds 1)
22 (with-test (:name (:deadline :defer-deadline-1))
26 (handler-bind ((sb-sys:deadline-timeout
30 (sb-sys:defer-deadline 0.1 c)))))
31 (sb-sys:with-deadline (:seconds 1)
33 (sb-sys:deadline-timeout (c)
38 (with-test (:name (:deadline :defer-deadline-2))
42 (handler-bind ((sb-sys:deadline-timeout
45 (sb-sys:defer-deadline 0.1 c))))
46 (sb-sys:with-deadline (:seconds 1)
48 (sb-sys:deadline-timeout (c)
51 (assert (not final))))
53 (with-test (:name (:deadline :cancel-deadline))
57 (handler-bind ((sb-sys:deadline-timeout
60 (sb-sys:cancel-deadline c))))
61 (sb-sys:with-deadline (:seconds 1)
63 (sb-sys:deadline-timeout (c)
66 (assert (not final))))
68 #+(and sb-thread (not sb-lutex))
71 (with-test (:name (:deadline :get-mutex))
73 (let ((lock (sb-thread:make-mutex))
75 (sb-thread:make-thread (lambda ()
76 (sb-thread:get-mutex lock)
79 (loop while waitp do (sleep 0.01))
80 (sb-sys:with-deadline (:seconds 1)
81 (sb-thread:get-mutex lock)))))
83 (with-test (:name (:deadline :wait-on-semaphore))
85 (let ((sem (sb-thread::make-semaphore :count 0)))
86 (sb-sys:with-deadline (:seconds 1)
87 (sb-thread::wait-on-semaphore sem)))))
89 (with-test (:name (:deadline :join-thread))
91 (sb-sys:with-deadline (:seconds 1)
92 (sb-thread:join-thread
93 (sb-thread:make-thread (lambda () (loop (sleep 1))))))))
95 (with-test (:name (:deadline :futex-wait-eintr))
96 (let ((lock (sb-thread:make-mutex))
98 (sb-thread:make-thread (lambda ()
99 (sb-thread:get-mutex lock)
102 (loop while waitp do (sleep 0.01))
103 (let ((thread (sb-thread:make-thread
105 (let ((start (get-internal-real-time)))
107 (sb-sys:with-deadline (:seconds 1)
108 (sb-thread:get-mutex lock))
109 (sb-sys:deadline-timeout (x)
111 (let ((end (get-internal-real-time)))
112 (float (/ (- end start)
113 internal-time-units-per-second)
116 (sb-thread:interrupt-thread thread (lambda () 42))
117 (let ((seconds-passed (sb-thread:join-thread thread)))
118 (format t "Deadline in ~S~%" seconds-passed)
119 (assert (< seconds-passed 1.2)))))))