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 (deftest gate.0
  15     (let ((gate (make-gate :open t)))
  16       (values (wait-on-gate gate)
  17               (close-gate gate)
  18               (wait-on-gate gate :timeout 0.1)))
  19   t
  20   t
  21   nil)
  22
  23 #+sb-thread
  24 (progn
  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.
  29   (deftest gate.1
  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)
  34                                                    (wait-on-gate gate)
  35                                                    (setf (aref marks n) (cons n (aref marks n))))
  36                                                  :arguments i)))
  37              (int-gate (make-gate)))
  38         (sleep 1)
  39         (interrupt-thread (car threads) (lambda ()
  40                                           (unwind-protect
  41                                                (when (gate-open-p gate)
  42                                                  (sb-ext:quit))
  43                                             (open-gate int-gate))))
  44         (wait-on-gate int-gate)
  45         (assert (every #'null marks))
  46         (open-gate gate)
  47         (mapc #'join-thread threads)
  48         (dotimes (i (length marks))
  49           (assert (equal (list i) (aref marks i))))
  50         t)
  51     t)
  52
  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.
  56   (deftest gate.2
  57       (let* ((gate (make-gate))
  58              (cont (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)
  62                                                    (wait-on-gate gate)
  63                                                    (when (oddp n)
  64                                                      (sleep 1.0))
  65                                                    (wait-on-gate gate)
  66                                                    (setf (aref marks n) (cons n (aref marks n))))
  67                                                  :arguments i))))
  68         (open-gate gate)
  69         (sleep 0.5)
  70         (close-gate gate)
  71         (let (odds evens)
  72           (loop while threads
  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)
  77                 do (if (oddp i)
  78                        (assert (not (aref marks i)))
  79                        (assert (equal (list i) (aref marks i)))))
  80           (open-gate gate)
  81           (mapc #'join-thread odds)
  82           (loop for i from 0 below (length marks)
  83                 do (when (oddp i)
  84                      (assert (equal (list i) (aref marks i)))))
  85           t))
  86     t)
  87
  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 ()
  92                                     (block nil
  93                                       (handler-bind ((sb-sys:deadline-timeout
  94                                                        #'(lambda (c)
  95                                                            (return :deadline))))
  96                                         (sb-sys:with-deadline (:seconds 0.1)
  97                                           (wait-on-gate gate))))))))
  98         (join-thread waiter))
  99     :deadline)
 100
 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))
 105              (ready (make-gate))
 106              (cancel nil)
 107              (waiter (make-thread (lambda ()
 108                                     (block nil
 109                                       (handler-bind ((sb-sys:deadline-timeout
 110                                                        #'(lambda (c)
 111                                                            (setf cancel t)
 112                                                            (sb-sys:cancel-deadline c))))
 113                                         (sb-sys:with-deadline (:seconds 0.1)
 114                                           (open-gate ready)
 115                                           (wait-on-gate gate))))))))
 116         (wait-on-gate ready)
 117         (sleep 1.0)
 118         (open-gate gate)
 119         (values (join-thread waiter) cancel))
 120     t t)
 121
 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))
 127     nil)
 128
 129   (deftest gate-timeout.2
 130       (let* ((gate (make-gate))
 131              (waiter (make-thread (lambda ()
 132                                     (open-gate gate)
 133                                     (wait-on-gate gate :timeout 0.1)))))
 134         (join-thread waiter))
 135     t))