[239125]: tests / deadline.impure.lisp Maximize Restore History

Download this file

deadline.impure.lisp    117 lines (105 with data), 4.2 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
(in-package :cl-user)
(use-package :test-util)
(defmacro assert-timeout (form)
(let ((ok (gensym "OK")))
`(let ((,ok ',ok))
(unless (eq ,ok
(handler-case ,form
(timeout ()
,ok)))
(error "No timeout from form:~% ~S" ',form)))))
(defun run-sleep (seconds)
(sb-ext:run-program "sleep" (list (format nil "~D" seconds))
:search t :wait t))
(with-test (:name (:deadline :run-program :trivial) :fails-on :win32)
(assert-timeout (sb-sys:with-deadline (:seconds 1)
(run-sleep 3))))
(with-test (:name (:deadline :defer-deadline-1) :fails-on :win32)
(let ((n 0)
(final nil))
(handler-case
(handler-bind ((sb-sys:deadline-timeout
#'(lambda (c)
(when (< n 2)
(incf n)
(sb-sys:defer-deadline 0.1 c)))))
(sb-sys:with-deadline (:seconds 1)
(run-sleep 2)))
(sb-sys:deadline-timeout (c)
(setf final c)))
(assert (= n 2))
(assert final)))
(with-test (:name (:deadline :defer-deadline-2) :fails-on :win32)
(let ((n 0)
(final nil))
(handler-case
(handler-bind ((sb-sys:deadline-timeout
#'(lambda (c)
(incf n)
(sb-sys:defer-deadline 0.1 c))))
(sb-sys:with-deadline (:seconds 1)
(run-sleep 2)))
(sb-sys:deadline-timeout (c)
(setf final c)))
(assert (plusp n))
(assert (not final))))
(with-test (:name (:deadline :cancel-deadline) :fails-on :win32)
(let ((n 0)
(final nil))
(handler-case
(handler-bind ((sb-sys:deadline-timeout
#'(lambda (c)
(incf n)
(sb-sys:cancel-deadline c))))
(sb-sys:with-deadline (:seconds 1)
(run-sleep 2)))
(sb-sys:deadline-timeout (c)
(setf final c)))
(assert (= n 1))
(assert (not final))))
(with-test (:name (:deadline :grab-mutex) :skipped-on '(not :sb-thread))
(assert-timeout
(let ((lock (sb-thread:make-mutex))
(waitp t))
(sb-thread:make-thread (lambda ()
(sb-thread:grab-mutex lock)
(setf waitp nil)
(sleep 5)))
(loop while waitp do (sleep 0.01))
(sb-sys:with-deadline (:seconds 1)
(sb-thread:grab-mutex lock)))))
(with-test (:name (:deadline :wait-on-semaphore) :skipped-on '(not :sb-thread))
(assert-timeout
(let ((sem (sb-thread::make-semaphore :count 0)))
(sb-sys:with-deadline (:seconds 1)
(sb-thread::wait-on-semaphore sem)))))
(with-test (:name (:deadline :join-thread) :skipped-on '(not :sb-thread))
(assert-timeout
(sb-sys:with-deadline (:seconds 1)
(sb-thread:join-thread
(sb-thread:make-thread (lambda () (loop (sleep 1))))))))
(with-test (:name (:deadline :futex-wait-eintr) :skipped-on '(not :sb-thread))
(let ((lock (sb-thread:make-mutex))
(waitp t))
(sb-thread:make-thread (lambda ()
(sb-thread:grab-mutex lock)
(setf waitp nil)
(sleep 5)))
(loop while waitp do (sleep 0.01))
(let ((thread (sb-thread:make-thread
(lambda ()
(let ((start (get-internal-real-time)))
(handler-case
(sb-sys:with-deadline (:seconds 1)
(sb-thread:grab-mutex lock))
(sb-sys:deadline-timeout (x)
(declare (ignore x))
(let ((end (get-internal-real-time)))
(float (/ (- end start)
internal-time-units-per-second)
0.0)))))))))
(sleep 0.3)
(sb-thread:interrupt-thread thread (lambda () 42))
(let ((seconds-passed (sb-thread:join-thread thread)))
(format t "Deadline in ~S~%" seconds-passed)
(assert (< seconds-passed 1.2))))))