In the mips sigtrap hander, and for the case of a break instruction in a
[sbcl.git] / tests / timer.impure.lisp
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
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
6 ;;;; from CMU CL.
7 ;;;;
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.
11
12 (in-package "CL-USER")
13
14 (use-package :test-util)
15
16 (with-test (:name (:timer :relative))
17   (let* ((has-run-p nil)
18          (timer (make-timer (lambda () (setq has-run-p t))
19                             :name "simple timer")))
20     (schedule-timer timer 0.5)
21     (sleep 0.2)
22     (assert (not has-run-p))
23     (sleep 0.5)
24     (assert has-run-p)
25     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
26
27 (with-test (:name (:timer :absolute))
28   (let* ((has-run-p nil)
29          (timer (make-timer (lambda () (setq has-run-p t))
30                             :name "simple timer")))
31     (schedule-timer timer (+ 1/2 (get-universal-time)) :absolute-p t)
32     (sleep 0.2)
33     (assert (not has-run-p))
34     (sleep 0.5)
35     (assert has-run-p)
36     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
37
38 #+sb-thread
39 (with-test (:name (:timer :other-thread))
40   (let* ((thread (sb-thread:make-thread (lambda () (sleep 2))))
41          (timer (make-timer (lambda ()
42                               (assert (eq thread sb-thread:*current-thread*)))
43                             :thread thread)))
44     (schedule-timer timer 0.1)))
45
46 #+sb-thread
47 (with-test (:name (:timer :new-thread))
48   (let* ((original-thread sb-thread:*current-thread*)
49          (timer (make-timer
50                  (lambda ()
51                    (assert (not (eq original-thread
52                                     sb-thread:*current-thread*))))
53                  :thread t)))
54     (schedule-timer timer 0.1)))
55
56 (with-test (:name (:timer :repeat-and-unschedule))
57   (let* ((run-count 0)
58          timer)
59     (setq timer
60           (make-timer (lambda ()
61                         (when (= 5 (incf run-count))
62                           (unschedule-timer timer)))))
63     (schedule-timer timer 0 :repeat-interval 0.2)
64     (assert (timer-scheduled-p timer :delta 0.3))
65     (sleep 1.3)
66     (assert (= 5 run-count))
67     (assert (not (timer-scheduled-p timer)))
68     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
69
70 (with-test (:name (:timer :reschedule))
71   (let* ((has-run-p nil)
72          (timer (make-timer (lambda ()
73                               (setq has-run-p t)))))
74     (schedule-timer timer 0.2)
75     (schedule-timer timer 0.3)
76     (sleep 0.5)
77     (assert has-run-p)
78     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
79
80 (with-test (:name (:timer :stress))
81   (let ((time (1+ (get-universal-time))))
82     (loop repeat 200 do
83           (schedule-timer (make-timer (lambda ())) time :absolute-p t))
84     (sleep 2)
85     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
86
87 (defmacro raises-timeout-p (&body body)
88   `(handler-case (progn (progn ,@body) nil)
89     (sb-ext:timeout () t)))
90
91 (with-test (:name (:with-timeout :timeout))
92   (assert (raises-timeout-p
93            (sb-ext:with-timeout 0.2
94              (sleep 1)))))
95
96 (with-test (:name (:with-timeout :fall-through))
97   (assert (not (raises-timeout-p
98                 (sb-ext:with-timeout 0.3
99                   (sleep 0.1))))))
100
101 (with-test (:name (:with-timeout :nested-timeout-smaller))
102   (assert(raises-timeout-p
103           (sb-ext:with-timeout 10
104             (sb-ext:with-timeout 0.5
105               (sleep 2))))))
106
107 (with-test (:name (:with-timeout :nested-timeout-bigger))
108   (assert(raises-timeout-p
109           (sb-ext:with-timeout 0.5
110             (sb-ext:with-timeout 2
111               (sleep 2))))))
112
113 #+sb-thread
114 (with-test (:name (:with-timeout :many-at-the-same-time))
115   (loop repeat 10 do
116         (sb-thread:make-thread
117          (lambda ()
118            (sb-ext:with-timeout 0.5
119              (sleep 5)
120              (assert nil))))))