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)
14 ;;; Create threads waiting until a gate is opened, then open that
15 ;;; gate and assure that all waiters were waked up. Also make sure
16 ;;; that interrupting a thread waiting on a gate doesn't make it
17 ;;; cross the gate if it is closed.
19 (let* ((gate (make-gate))
20 (marks (make-array 100 :initial-element nil))
21 (threads (loop for i from 0 below (length marks)
22 collect (make-thread (lambda (n)
24 (setf (aref marks n) (cons n (aref marks n))))
26 (int-gate (make-gate)))
28 (interrupt-thread (car threads) (lambda ()
30 (when (gate-open-p gate)
32 (open-gate int-gate))))
33 (wait-on-gate int-gate)
34 (assert (every #'null marks))
36 (mapc #'join-thread threads)
37 (dotimes (i (length marks))
38 (assert (equal (list i) (aref marks i))))
42 ;;; Assure that CLOSE-GATE can close a gate while other threads are operating
43 ;;; through that gate. In particular, assure that no operation is performed
44 ;;; once the gate is closed.
46 (let* ((gate (make-gate))
48 (marks (make-array 100 :initial-element nil))
49 (threads (loop for i from 0 below (length marks)
50 collect (make-thread (lambda (n)
55 (setf (aref marks n) (cons n (aref marks n))))
62 do (push (pop threads) evens)
63 (push (pop threads) odds))
64 (mapc #'join-thread evens)
65 (loop for i from 0 below (length marks)
67 (assert (not (aref marks i)))
68 (assert (equal (list i) (aref marks i)))))
70 (mapc #'join-thread odds)
71 (loop for i from 0 below (length marks)
73 (assert (equal (list i) (aref marks i)))))
77 ;;; Assures that WAIT-ON-GATE can be interrupted by deadlines.
78 (deftest gate-deadline.1
79 (let* ((gate (make-gate))
80 (waiter (make-thread (lambda ()
82 (handler-bind ((sb-sys:deadline-timeout
85 (sb-sys:with-deadline (:seconds 0.1)
86 (wait-on-gate gate))))))))
90 ;;; Assure that WAIT-ON-GATE can be interrupted by deadlines, and resumed from
91 ;;; the deadline handler.
92 (deftest gate-deadline.1
93 (let* ((gate (make-gate))
96 (waiter (make-thread (lambda ()
98 (handler-bind ((sb-sys:deadline-timeout
101 (sb-sys:cancel-deadline c))))
102 (sb-sys:with-deadline (:seconds 0.1)
104 (wait-on-gate gate))))))))
108 (values (join-thread waiter) cancel))
111 (deftest gate-timeout.1
112 (let* ((gate (make-gate))
113 (waiter (make-thread (lambda ()
114 (wait-on-gate gate :timeout 0.1)))))
115 (join-thread waiter))
118 (deftest gate-timeout.2
119 (let* ((gate (make-gate))
120 (waiter (make-thread (lambda ()
122 (wait-on-gate gate :timeout 0.1)))))
123 (join-thread waiter))