3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package :sb-concurrency-test)
15 (let ((gate (make-gate :open t)))
16 (values (wait-on-gate gate)
18 (wait-on-gate gate :timeout 0.1)))
25 ;; Create threads waiting until a gate is opened, then open that
26 ;; gate and assure that all waiters were waked up. Also make sure
27 ;; that interrupting a thread waiting on a gate doesn't make it
28 ;; cross the gate if it is closed.
30 (let* ((gate (make-gate))
31 (marks (make-array 100 :initial-element nil))
32 (threads (loop for i from 0 below (length marks)
33 collect (make-thread (lambda (n)
35 (setf (aref marks n) (cons n (aref marks n))))
37 (int-gate (make-gate)))
39 (interrupt-thread (car threads) (lambda ()
41 (when (gate-open-p gate)
43 (open-gate int-gate))))
44 (wait-on-gate int-gate)
45 (assert (every #'null marks))
47 (mapc #'join-thread threads)
48 (dotimes (i (length marks))
49 (assert (equal (list i) (aref marks i))))
53 ;; Assure that CLOSE-GATE can close a gate while other threads are operating
54 ;; through that gate. In particular, assure that no operation is performed
55 ;; once the gate is closed.
57 (let* ((gate (make-gate))
59 (marks (make-array 100 :initial-element nil))
60 (threads (loop for i from 0 below (length marks)
61 collect (make-thread (lambda (n)
66 (setf (aref marks n) (cons n (aref marks n))))
73 do (push (pop threads) evens)
74 (push (pop threads) odds))
75 (mapc #'join-thread evens)
76 (loop for i from 0 below (length marks)
78 (assert (not (aref marks i)))
79 (assert (equal (list i) (aref marks i)))))
81 (mapc #'join-thread odds)
82 (loop for i from 0 below (length marks)
84 (assert (equal (list i) (aref marks i)))))
88 ;; Assures that WAIT-ON-GATE can be interrupted by deadlines.
89 (deftest gate-deadline.1
90 (let* ((gate (make-gate))
91 (waiter (make-thread (lambda ()
93 (handler-bind ((sb-sys:deadline-timeout
96 (sb-sys:with-deadline (:seconds 0.1)
97 (wait-on-gate gate))))))))
101 ;; Assure that WAIT-ON-GATE can be interrupted by deadlines, and resumed from
102 ;; the deadline handler.
103 (deftest gate-deadline.2
104 (let* ((gate (make-gate))
107 (waiter (make-thread (lambda ()
109 (handler-bind ((sb-sys:deadline-timeout
112 (sb-sys:cancel-deadline c))))
113 (sb-sys:with-deadline (:seconds 0.1)
115 (wait-on-gate gate))))))))
119 (values (join-thread waiter) cancel))
122 (deftest gate-timeout.1
123 (let* ((gate (make-gate))
124 (waiter (make-thread (lambda ()
125 (wait-on-gate gate :timeout 0.1)))))
126 (join-thread waiter))
129 (deftest gate-timeout.2
130 (let* ((gate (make-gate))
131 (waiter (make-thread (lambda ()
133 (wait-on-gate gate :timeout 0.1)))))
134 (join-thread waiter))