contrib/sb-concurrency/tests/test-gate.lisp

   1 ;;;; -*-  Lisp -*-
   2 ;;;;
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package :sb-concurrency-test)
  13
  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.
  18 (deftest gate.1
  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)
  23                                                  (wait-on-gate gate)
  24                                                  (setf (aref marks n) (cons n (aref marks n))))
  25                                                :arguments i)))
  26            (int-gate (make-gate)))
  27       (sleep 1)
  28       (interrupt-thread (car threads) (lambda ()
  29                                         (unwind-protect
  30                                              (when (gate-open-p gate)
  31                                                (sb-ext:quit))
  32                                           (open-gate int-gate))))
  33       (wait-on-gate int-gate)
  34       (assert (every #'null marks))
  35       (open-gate gate)
  36       (mapc #'join-thread threads)
  37       (dotimes (i (length marks))
  38         (assert (equal (list i) (aref marks i))))
  39       t)
  40   t)
  41
  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.
  45 (deftest gate.2
  46     (let* ((gate (make-gate))
  47            (cont (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)
  51                                                  (wait-on-gate gate)
  52                                                  (when (oddp n)
  53                                                    (sleep 1.0))
  54                                                  (wait-on-gate gate)
  55                                                  (setf (aref marks n) (cons n (aref marks n))))
  56                                                :arguments i))))
  57       (open-gate gate)
  58       (sleep 0.5)
  59       (close-gate gate)
  60       (let (odds evens)
  61         (loop while threads
  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)
  66               do (if (oddp i)
  67                      (assert (not (aref marks i)))
  68                      (assert (equal (list i) (aref marks i)))))
  69         (open-gate gate)
  70         (mapc #'join-thread odds)
  71         (loop for i from 0 below (length marks)
  72               do (when (oddp i)
  73                    (assert (equal (list i) (aref marks i)))))
  74         t))
  75   t)
  76
  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 ()
  81                                   (block nil
  82                                     (handler-bind ((sb-sys:deadline-timeout
  83                                                      #'(lambda (c)
  84                                                          (return :deadline))))
  85                                       (sb-sys:with-deadline (:seconds 0.1)
  86                                         (wait-on-gate gate))))))))
  87       (join-thread waiter))
  88   :deadline)
  89
  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))
  94            (ready (make-gate))
  95            (cancel nil)
  96            (waiter (make-thread (lambda ()
  97                                   (block nil
  98                                     (handler-bind ((sb-sys:deadline-timeout
  99                                                      #'(lambda (c)
 100                                                          (setf cancel t)
 101                                                          (sb-sys:cancel-deadline c))))
 102                                       (sb-sys:with-deadline (:seconds 0.1)
 103                                         (open-gate ready)
 104                                         (wait-on-gate gate))))))))
 105       (wait-on-gate ready)
 106       (sleep 1.0)
 107       (open-gate gate)
 108       (values (join-thread waiter) cancel))
 109   t t)
 110
 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))
 116   nil)
 117
 118 (deftest gate-timeout.2
 119     (let* ((gate (make-gate))
 120            (waiter (make-thread (lambda ()
 121                                   (open-gate gate)
 122                                   (wait-on-gate gate :timeout 0.1)))))
 123       (join-thread waiter))
 124   t)