sb-concurrency: GATE tweak, fix building without threads

 * OPEN-GATE wasn't interrupt-safe. Don't want to have an interrupt unwind
   after opening the gate but before broadcasting on the condition variable.

 * Disable tests needing threads on unithread builds, add one that
   doesn't need threads.

 Also: many thanks to Tobias Rittweiler on whose code the GATE implementation
 is based!

diff --git a/contrib/sb-concurrency/gate.lisp b/contrib/sb-concurrency/gate.lisp
index 9628d57..b51c37c 100644 (file)
--- a/contrib/sb-concurrency/gate.lisp
+++ b/contrib/sb-concurrency/gate.lisp
@@ -58,9 +58,10 @@ if the gate was already open."
   (declare (gate gate))
   (let (closed)
     (with-mutex ((gate-mutex gate))
-      (setf closed (eq :closed (gate-state gate))
-            (gate-state gate) :open)
-      (condition-broadcast (gate-queue gate)))
+      (sb-sys:without-interrupts
+        (setf closed (eq :closed (gate-state gate))
+              (gate-state gate) :open)
+        (condition-broadcast (gate-queue gate))))
     closed))
 
 (defun close-gate (gate)

diff --git a/contrib/sb-concurrency/tests/test-gate.lisp b/contrib/sb-concurrency/tests/test-gate.lisp
index a25a07e..9575d3c 100644 (file)
--- a/contrib/sb-concurrency/tests/test-gate.lisp
+++ b/contrib/sb-concurrency/tests/test-gate.lisp
@@ -11,114 +11,125 @@
 
 (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))