tests/deadline.impure.lisp

   1 (in-package :cl-user)
   2
   3 (use-package :test-util)
   4
   5 (defmacro assert-timeout ((expected-message) form)
   6   (let ((ok (gensym "OK")))
   7     `(let ((,ok ',ok))
   8        (unless (eq ,ok
   9                    (handler-case ,form
  10                      (timeout (condition)
  11                        (assert (string= ,expected-message
  12                                         (princ-to-string condition)))
  13                        ,ok)))
  14          (error "No timeout from form:~%  ~S" ',form)))))
  15
  16 (defun run-sleep (seconds)
  17   (sb-ext:run-program "sleep" (list (format nil "~D" seconds))
  18                       :search t :wait t))
  19
  20 (with-test (:name (sb-sys:decode-timeout :large-values :lp-1727789))
  21   (flet ((test (seconds)
  22            (assert (not (sb-sys:decode-timeout seconds)))))
  23     (test (expt 2 64))
  24     (test (1+ sb-kernel:internal-seconds-limit))
  25     (test (float (1+ sb-kernel:internal-seconds-limit) 1.0f0))
  26     (test (float (1+ sb-kernel:internal-seconds-limit) 1.0d0))))
  27
  28 (with-test (:name (sb-sys:with-deadline :large-values :lp-1727789))
  29   (flet ((test (seconds)
  30            (let ((sem (sb-thread:make-semaphore :count 0)))
  31              (assert-timeout ("A deadline was reached after 0 seconds.")
  32                (sb-sys:with-deadline (:seconds seconds)
  33                  (sb-sys:with-deadline (:seconds 0)
  34                    (sb-thread:wait-on-semaphore sem)))))))
  35     (test (1+ most-positive-fixnum))
  36     (test (1+ sb-kernel:internal-seconds-limit))
  37     (test (float (1+ sb-kernel:internal-seconds-limit) 1.0f0))
  38     (test (float (1+ sb-kernel:internal-seconds-limit) 1.0d0))))
  39
  40 (with-test (:name (:deadline sb-ext:run-program :trivial) :fails-on :win32)
  41   (assert-timeout ("A deadline was reached after 1 second.")
  42     (sb-sys:with-deadline (:seconds 1)
  43       (run-sleep 3))))
  44
  45 (with-test (:name (:deadline sb-sys:defer-deadline 1) :fails-on :win32)
  46   (let ((n 0))
  47     (assert-timeout ("A deadline was reached after 0.1 seconds.")
  48       (handler-bind ((sb-sys:deadline-timeout
  49                       (lambda (c)
  50                         (when (< n 2)
  51                           (incf n)
  52                           (sb-sys:defer-deadline 0.1 c)))))
  53         (sb-sys:with-deadline (:seconds 1)
  54           (run-sleep 2))))
  55     (assert (= n 2))))
  56
  57 (with-test (:name (:deadline sb-sys:defer-deadline 2) :fails-on :win32)
  58   (let ((n 0)
  59         (final nil))
  60     (handler-case
  61         (handler-bind ((sb-sys:deadline-timeout
  62                         (lambda (c)
  63                           (incf n)
  64                           (sb-sys:defer-deadline 0.1 c))))
  65           (sb-sys:with-deadline (:seconds 1)
  66             (run-sleep 2)))
  67       (sb-sys:deadline-timeout (c)
  68         (setf final c)))
  69     (assert (plusp n))
  70     (assert (not final))))
  71
  72 (with-test (:name (:deadline sb-sys:defer-deadline 3) :fails-on :win32)
  73   (let ((n 0))
  74     (assert-timeout ("A deadline was reached after 0.1 seconds.")
  75       (handler-bind ((sb-sys:deadline-timeout
  76                       (lambda (condition)
  77                         (declare (ignore condition))
  78                         (when (< n 2)
  79                           (incf n)
  80                           (invoke-restart 'sb-sys:defer-deadline)))))
  81         (sb-sys:with-deadline (:seconds .1)
  82           (run-sleep 3))))
  83     (assert (plusp n))))
  84
  85 (with-test (:name (:deadline sb-sys:cancel-deadline) :fails-on :win32)
  86   (let ((n 0)
  87         (final nil))
  88     (handler-case
  89         (handler-bind ((sb-sys:deadline-timeout
  90                         (lambda (c)
  91                           (incf n)
  92                           (sb-sys:cancel-deadline c))))
  93           (sb-sys:with-deadline (:seconds 1)
  94             (run-sleep 2)))
  95       (sb-sys:deadline-timeout (c)
  96         (setf final c)))
  97     (assert (= n 1))
  98     (assert (not final))))
  99
 100 (with-test (:name (:deadline sb-thread:grab-mutex)
 101                   :skipped-on (not :sb-thread))
 102   (assert-timeout ("A deadline was reached after 1 second.")
 103     (let ((lock (sb-thread:make-mutex))
 104           (waitp t))
 105       (make-join-thread (lambda ()
 106                           (sb-thread:grab-mutex lock)
 107                           (setf waitp nil)
 108                           (sleep 5)))
 109       (loop while waitp do (sleep 0.01))
 110       (sb-sys:with-deadline (:seconds 1)
 111         (sb-thread:grab-mutex lock)))))
 112
 113 (with-test (:name (:deadline sb-thread:wait-on-semaphore)
 114                   :skipped-on (not :sb-thread))
 115   (assert-timeout ("A deadline was reached after 1 second.")
 116     (let ((sem (sb-thread:make-semaphore :count 0)))
 117       (sb-sys:with-deadline (:seconds 1)
 118         (sb-thread:wait-on-semaphore sem)))))
 119
 120 (with-test (:name (:deadline sb-thread:join-thread)
 121             :skipped-on (not :sb-thread)
 122             :broken-on :win32)
 123   (assert-timeout ("A deadline was reached after 1 second.")
 124     (sb-sys:with-deadline (:seconds 1)
 125       (sb-thread:join-thread
 126        (make-kill-thread (lambda () (loop (sleep 1))))))))
 127
 128 (with-test (:name (:deadline :futex-wait-eintr)
 129             :skipped-on (not :sb-thread)
 130             :broken-on :win32)
 131   (let ((lock (sb-thread:make-mutex))
 132         (waitp t))
 133     (make-join-thread (lambda ()
 134                         (sb-thread:grab-mutex lock)
 135                         (setf waitp nil)
 136                         (sleep 5)))
 137     (loop while waitp do (sleep 0.01))
 138     (let ((thread (make-join-thread
 139                    (lambda ()
 140                      (let ((start (get-internal-real-time)))
 141                        (handler-case
 142                            (sb-sys:with-deadline (:seconds 1)
 143                              (sb-thread:grab-mutex lock))
 144                          (sb-sys:deadline-timeout (x)
 145                            (declare (ignore x))
 146                            (let ((end (get-internal-real-time)))
 147                              (float (/ (- end start)
 148                                        internal-time-units-per-second)
 149                                     0.0)))))))))
 150       (sleep 0.3)
 151       (sb-thread:interrupt-thread thread (lambda () 42))
 152       (let ((seconds-passed (sb-thread:join-thread thread)))
 153         (assert (< seconds-passed 1.2))))))
 154 \f
 155 ;;;; Sleep
 156
 157 (with-test (:name (sb-sys:with-deadline sleep :smoke))
 158   (assert-timeout ("A deadline was reached after 0.1 seconds.")
 159     (sb-sys:with-deadline (:seconds .1) (sleep 1)))
 160
 161   (assert-no-signal
 162       (sb-sys:with-deadline (:seconds .2) (sleep .1))
 163     sb-sys:deadline-timeout))
 164
 165 (with-test (:name (sb-sys:with-deadline sleep :long-sleep))
 166   (assert-timeout ("A deadline was reached after 0.1 seconds.")
 167     (sb-sys:with-deadline (:seconds .1)
 168       (sleep (1+ sb-kernel:internal-seconds-limit)))))
 169
 170 (with-test (:name (sb-sys:with-deadline sleep :no-sleep))
 171   ;; When SLEEP is called in the context of an expired deadline, the
 172   ;; DEADLINE-TIMEOUT must be signaled even if there is no sleeping to
 173   ;; be done.
 174   (assert-timeout ("A deadline was reached after 0.1 seconds.")
 175     (sb-sys:with-deadline (:seconds .1)
 176       (let ((sb-impl::*deadline* nil)) (sleep .2))
 177       (sleep 0))))
 178
 179 (with-test (:name (sb-sys:with-deadline sleep sb-sys:defer-deadline))
 180   (let ((n 0))
 181     (assert-no-signal
 182         (handler-bind ((sb-sys:deadline-timeout
 183                         (lambda (condition)
 184                           (incf n)
 185                           (sb-sys:defer-deadline .1 condition))))
 186           (sb-sys:with-deadline (:seconds .1) (sleep .5)))
 187       sb-sys:deadline-timeout)
 188     (assert (plusp n))))
 189
 190 (with-test (:name (sb-sys:with-deadline sleep sb-sys:cancel-deadline))
 191   (assert-no-signal
 192       (handler-bind ((sb-sys:deadline-timeout
 193                       (lambda (condition)
 194                         (sb-sys:cancel-deadline condition))))
 195         (sb-sys:with-deadline (:seconds .1) (sleep 1)))
 196     sb-sys:deadline-timeout))