(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)
+(deftest gate.0
+ (let ((gate (make-gate :open t)))
+ (values (wait-on-gate gate)
+ (close-gate gate)
+ (wait-on-gate gate :timeout 0.1)))
+ t
+ t
+ nil)
-;;; 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)))))
+#+sb-thread
+(progn
+ ;; 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 odds)
- (loop for i from 0 below (length marks)
- do (when (oddp i)
- (assert (equal (list i) (aref marks i)))))
- t))
- t)
+ (mapc #'join-thread threads)
+ (dotimes (i (length marks))
+ (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 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)
-;;; 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)
+ ;; 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)
-(deftest gate-timeout.1
- (let* ((gate (make-gate))
- (waiter (make-thread (lambda ()
- (wait-on-gate gate :timeout 0.1)))))
- (join-thread waiter))
- nil)
+ ;; Assure that WAIT-ON-GATE can be interrupted by deadlines, and resumed from
+ ;; the deadline handler.
+ (deftest gate-deadline.2
+ (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)
+ (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))