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-sys:with-deadline (:seconds 1)
  13    (run-program "sleep" '("3") :search t :wait t)))
  14
  15 (let ((n 0)
  16       (final nil))
  17   (handler-case
  18       (handler-bind ((sb-sys:deadline-timeout (lambda (c)
  19                                                 (when (< n 2)
  20                                                   (incf n)
  21                                                   (sb-sys:defer-deadline 0.1 c)))))
  22         (sb-sys:with-deadline (:seconds 1)
  23           (run-program "sleep" '("2") :search t :wait t)))
  24     (sb-sys:deadline-timeout (c)
  25       (setf final c)))
  26   (assert (= n 2))
  27   (assert final))
  28
  29 (let ((n 0)
  30       (final nil))
  31   (handler-case
  32       (handler-bind ((sb-sys:deadline-timeout (lambda (c)
  33                                                 (incf n)
  34                                                 (sb-sys:defer-deadline 0.1 c))))
  35         (sb-sys:with-deadline (:seconds 1)
  36           (run-program "sleep" '("2") :search t :wait t)))
  37     (sb-sys:deadline-timeout (c)
  38       (setf final c)))
  39   (assert (plusp n))
  40   (assert (not final)))
  41
  42 #+(and sb-thread (not sb-lutex))
  43 (progn
  44   (assert-timeout
  45    (let ((lock (sb-thread:make-mutex))
  46          (waitp t))
  47      (sb-thread:make-thread (lambda ()
  48                               (sb-thread:get-mutex lock)
  49                               (setf waitp nil)
  50                               (sleep 5)))
  51      (loop while waitp do (sleep 0.01))
  52      (sb-impl::with-deadline (:seconds 1)
  53        (sb-thread:get-mutex lock))))
  54
  55   (assert-timeout
  56    (let ((sem (sb-thread::make-semaphore :count 0)))
  57      (sb-impl::with-deadline (:seconds 1)
  58        (sb-thread::wait-on-semaphore sem))))
  59
  60   (assert-timeout
  61    (sb-impl::with-deadline (:seconds 1)
  62      (sb-thread:join-thread
  63       (sb-thread:make-thread (lambda () (loop (sleep 1)))))))
  64
  65   (with-test (:name (:deadline :futex-wait-eintr))
  66     (let ((lock (sb-thread:make-mutex))
  67           (waitp t))
  68       (sb-thread:make-thread (lambda ()
  69                                (sb-thread:get-mutex lock)
  70                                (setf waitp nil)
  71                                (sleep 5)))
  72       (loop while waitp do (sleep 0.01))
  73       (let ((thread (sb-thread:make-thread
  74                      (lambda ()
  75                        (let ((start (get-internal-real-time)))
  76                          (handler-case
  77                              (sb-impl::with-deadline (:seconds 1)
  78                                (sb-thread:get-mutex lock))
  79                            (sb-sys:deadline-timeout (x)
  80                              (declare (ignore x))
  81                              (let ((end (get-internal-real-time)))
  82                                (float (/ (- end start)
  83                                          internal-time-units-per-second)
  84                                       0.0)))))))))
  85         (sleep 0.3)
  86         (sb-thread:interrupt-thread thread (lambda () 42))
  87         (let ((seconds-passed (sb-thread:join-thread thread)))
  88           (format t "Deadline in ~S~%" seconds-passed)
  89           (assert (< seconds-passed 1.2)))))))