+;;;; -*- Lisp -*-
+;;;;
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package :sb-concurrency-test)
+
+;;; Create threads waiting until a gate is opened, then open that
+;;; gate and assure that all waiters were waked up. Also make sure
+;;; that interrupting a thread waiting on a gate doesn't make it
+;;; cross the gate if it is closed.
+(deftest gate.1
+ (let* ((gate (make-gate))
+ (marks (make-array 100 :initial-element nil))
+ (threads (loop for i from 0 below (length marks)
+ collect (make-thread (lambda (n)
+ (wait-on-gate gate)
+ (setf (aref marks n) (cons n (aref marks n))))
+ :arguments i)))
+ (int-gate (make-gate)))
+ (sleep 1)
+ (interrupt-thread (car threads) (lambda ()
+ (unwind-protect
+ (when (gate-open-p gate)
+ (sb-ext:quit))
+ (open-gate int-gate))))
+ (wait-on-gate int-gate)
+ (assert (every #'null marks))
+ (open-gate gate)
+ (mapc #'join-thread threads)
+ (dotimes (i (length marks))
+ (assert (equal (list i) (aref marks i))))
+ t)
+ t)
+
+;;; Assure that CLOSE-GATE can close a gate while other threads are operating
+;;; through that gate. In particular, assure that no operation is performed
+;;; once the gate is closed.
+(deftest gate.2
+ (let* ((gate (make-gate))
+ (cont (make-gate))
+ (marks (make-array 100 :initial-element nil))
+ (threads (loop for i from 0 below (length marks)
+ collect (make-thread (lambda (n)
+ (wait-on-gate gate)
+ (when (oddp n)
+ (sleep 1.0))
+ (wait-on-gate gate)
+ (setf (aref marks n) (cons n (aref marks n))))
+ :arguments i))))
+ (open-gate gate)
+ (sleep 0.5)
+ (close-gate gate)
+ (let (odds evens)
+ (loop while threads
+ do (push (pop threads) evens)
+ (push (pop threads) odds))
+ (mapc #'join-thread evens)
+ (loop for i from 0 below (length marks)
+ do (if (oddp i)
+ (assert (not (aref marks i)))
+ (assert (equal (list i) (aref marks i)))))
+ (open-gate gate)
+ (mapc #'join-thread odds)
+ (loop for i from 0 below (length marks)
+ do (when (oddp i)
+ (assert (equal (list i) (aref marks i)))))
+ t))
+ t)
+
+;;; Assures that WAIT-ON-GATE can be interrupted by deadlines.
+(deftest gate-deadline.1
+ (let* ((gate (make-gate))
+ (waiter (make-thread (lambda ()
+ (block nil
+ (handler-bind ((sb-sys:deadline-timeout
+ #'(lambda (c)
+ (return :deadline))))
+ (sb-sys:with-deadline (:seconds 0.1)
+ (wait-on-gate gate))))))))
+ (join-thread waiter))
+ :deadline)
+
+;;; Assure that WAIT-ON-GATE can be interrupted by deadlines, and resumed from
+;;; the deadline handler.
+(deftest gate-deadline.1
+ (let* ((gate (make-gate))
+ (ready (make-gate))
+ (cancel nil)
+ (waiter (make-thread (lambda ()
+ (block nil
+ (handler-bind ((sb-sys:deadline-timeout
+ #'(lambda (c)
+ (setf cancel t)
+ (sb-sys:cancel-deadline c))))
+ (sb-sys:with-deadline (:seconds 0.1)
+ (open-gate ready)
+ (wait-on-gate gate))))))))
+ (wait-on-gate ready)
+ (sleep 1.0)
+ (open-gate gate)
+ (values (join-thread waiter) cancel))
+ t t)
+
+(deftest gate-timeout.1
+ (let* ((gate (make-gate))
+ (waiter (make-thread (lambda ()
+ (wait-on-gate gate :timeout 0.1)))))
+ (join-thread waiter))
+ nil)
+
+(deftest gate-timeout.2
+ (let* ((gate (make-gate))
+ (waiter (make-thread (lambda ()
+ (open-gate gate)
+ (wait-on-gate gate :timeout 0.1)))))
+ (join-thread waiter))
+ t)