1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; While most of SBCL is derived from the CMU CL system, the test
5 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; This software is in the public domain and is provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
10 ;;;; more information.
12 (in-package "CL-USER")
14 (use-package :test-util)
16 (with-test (:name (:timer :relative))
17 (let* ((has-run-p nil)
18 (timer (sb-impl::make-timer (lambda () (setq has-run-p t))
19 :name "simple timer")))
20 (sb-impl::schedule-timer timer 0.5)
22 (assert (not has-run-p))
25 (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
27 (with-test (:name (:timer :absolute))
28 (let* ((has-run-p nil)
29 (timer (sb-impl::make-timer (lambda () (setq has-run-p t))
30 :name "simple timer")))
31 (sb-impl::schedule-timer timer (+ 1/2 (get-universal-time))
34 (assert (not has-run-p))
37 (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
42 (with-test (:name (:timer :other-thread))
43 (let* ((thread (sb-thread:make-thread (lambda () (let ((*x* t)) (sleep 2)))))
44 (timer (sb-impl::make-timer (lambda () (assert *x*)) :thread thread)))
45 (sb-impl::schedule-timer timer 0.1)))
48 (with-test (:name (:timer :new-thread))
50 (timer (sb-impl::make-timer (lambda () (assert (not *x*))) :thread t)))
51 (sb-impl::schedule-timer timer 0.1)))
53 (with-test (:name (:timer :repeat-and-unschedule))
57 (sb-impl::make-timer (lambda ()
58 (when (= 5 (incf run-count))
59 (sb-impl::unschedule-timer timer)))))
60 (sb-impl::schedule-timer timer 0 :repeat-interval 0.2)
61 (assert (not (sb-impl::timer-expired-p timer 0.3)))
63 (assert (= 5 run-count))
64 (assert (sb-impl::timer-expired-p timer))
65 (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
67 (with-test (:name (:timer :reschedule))
68 (let* ((has-run-p nil)
69 (timer (sb-impl::make-timer (lambda ()
70 (setq has-run-p t)))))
71 (sb-impl::schedule-timer timer 0.2)
72 (sb-impl::schedule-timer timer 0.3)
75 (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
77 (with-test (:name (:timer :stress))
78 (let ((time (1+ (get-universal-time))))
80 (sb-impl::schedule-timer (sb-impl::make-timer (lambda ())) time
83 (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
85 (defmacro raises-timeout-p (&body body)
86 `(handler-case (progn (progn ,@body) nil)
87 (sb-ext:timeout () t)))
89 (with-test (:name (:with-timeout :timeout))
90 (assert (raises-timeout-p
91 (sb-ext:with-timeout 0.2
94 (with-test (:name (:with-timeout :fall-through))
95 (assert (not (raises-timeout-p
96 (sb-ext:with-timeout 0.3
99 (with-test (:name (:with-timeout :nested-timeout-smaller))
100 (assert(raises-timeout-p
101 (sb-ext:with-timeout 10
102 (sb-ext:with-timeout 0.5
105 (with-test (:name (:with-timeout :nested-timeout-bigger))
106 (assert(raises-timeout-p
107 (sb-ext:with-timeout 0.5
108 (sb-ext:with-timeout 2