File: timer.impure.lisp

package info (click to toggle)
sbcl 1%3A0.9.16.0-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 19,960 kB
  • ctags: 16,537
  • sloc: lisp: 231,164; ansic: 19,558; asm: 2,539; sh: 1,925; makefile: 308
file content (120 lines) | stat: -rw-r--r-- 4,041 bytes parent folder | download
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
117
118
119
120
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.

(in-package "CL-USER")

(use-package :test-util)

(with-test (:name (:timer :relative))
  (let* ((has-run-p nil)
         (timer (make-timer (lambda () (setq has-run-p t))
                            :name "simple timer")))
    (schedule-timer timer 0.5)
    (sleep 0.2)
    (assert (not has-run-p))
    (sleep 0.5)
    (assert has-run-p)
    (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))

(with-test (:name (:timer :absolute))
  (let* ((has-run-p nil)
         (timer (make-timer (lambda () (setq has-run-p t))
                            :name "simple timer")))
    (schedule-timer timer (+ 1/2 (get-universal-time)) :absolute-p t)
    (sleep 0.2)
    (assert (not has-run-p))
    (sleep 0.5)
    (assert has-run-p)
    (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))

#+sb-thread
(with-test (:name (:timer :other-thread))
  (let* ((thread (sb-thread:make-thread (lambda () (sleep 2))))
         (timer (make-timer (lambda ()
                              (assert (eq thread sb-thread:*current-thread*)))
                            :thread thread)))
    (schedule-timer timer 0.1)))

#+sb-thread
(with-test (:name (:timer :new-thread))
  (let* ((original-thread sb-thread:*current-thread*)
         (timer (make-timer
                 (lambda ()
                   (assert (not (eq original-thread
                                    sb-thread:*current-thread*))))
                 :thread t)))
    (schedule-timer timer 0.1)))

(with-test (:name (:timer :repeat-and-unschedule))
  (let* ((run-count 0)
         timer)
    (setq timer
          (make-timer (lambda ()
                        (when (= 5 (incf run-count))
                          (unschedule-timer timer)))))
    (schedule-timer timer 0 :repeat-interval 0.2)
    (assert (timer-scheduled-p timer :delta 0.3))
    (sleep 1.3)
    (assert (= 5 run-count))
    (assert (not (timer-scheduled-p timer)))
    (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))

(with-test (:name (:timer :reschedule))
  (let* ((has-run-p nil)
         (timer (make-timer (lambda ()
                              (setq has-run-p t)))))
    (schedule-timer timer 0.2)
    (schedule-timer timer 0.3)
    (sleep 0.5)
    (assert has-run-p)
    (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))

(with-test (:name (:timer :stress))
  (let ((time (1+ (get-universal-time))))
    (loop repeat 200 do
          (schedule-timer (make-timer (lambda ())) time :absolute-p t))
    (sleep 2)
    (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))

(defmacro raises-timeout-p (&body body)
  `(handler-case (progn (progn ,@body) nil)
    (sb-ext:timeout () t)))

(with-test (:name (:with-timeout :timeout))
  (assert (raises-timeout-p
           (sb-ext:with-timeout 0.2
             (sleep 1)))))

(with-test (:name (:with-timeout :fall-through))
  (assert (not (raises-timeout-p
                (sb-ext:with-timeout 0.3
                  (sleep 0.1))))))

(with-test (:name (:with-timeout :nested-timeout-smaller))
  (assert(raises-timeout-p
          (sb-ext:with-timeout 10
            (sb-ext:with-timeout 0.5
              (sleep 2))))))

(with-test (:name (:with-timeout :nested-timeout-bigger))
  (assert(raises-timeout-p
          (sb-ext:with-timeout 0.5
            (sb-ext:with-timeout 2
              (sleep 2))))))

#+sb-thread
(with-test (:name (:with-timeout :many-at-the-same-time))
  (loop repeat 10 do
        (sb-thread:make-thread
         (lambda ()
           (sb-ext:with-timeout 0.5
             (sleep 5)
             (assert nil))))))