1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was written at
5 ;;;; Carnegie Mellon University and released into the public domain. The
6 ;;;; software is in the public domain and is provided with absolutely no
7 ;;;; warranty. See the COPYING and CREDITS files for more information.
9 (in-package :sb-concurrency-test)
12 (let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
14 (values (queue-name q)
15 (multiple-value-list (dequeue q))
16 (list-queue-contents q)))
22 (dequeue (make-queue))
27 (dequeue (make-queue :initial-contents '(nil)))
32 (let ((x (make-instance 'structure-object))
34 ;; I wonder why I thought this needs testing?
35 (values (typep x 'queue)
42 (let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
43 (values (= 5 (queue-count q))
56 (not (queue-empty-p q))
86 (let* ((q (make-queue))
91 (make-thread (lambda ()
95 (enqueue (cons :a i) q))))
96 (make-thread (lambda ()
100 (enqueue (cons :b i) q))))
101 (make-thread (lambda ()
103 (wait-on-semaphore w)
105 (enqueue (cons :c i) q))))
106 (make-thread (lambda ()
108 (wait-on-semaphore w)
110 (enqueue (cons :d i) q)))))))
111 (loop repeat 4 do (wait-on-semaphore r))
112 (signal-semaphore w 4)
113 (mapc #'join-thread schedulers)
116 (multiple-value-bind (item ok) (dequeue q)
120 (:a (push (cdr item) a))
121 (:b (push (cdr item) b))
122 (:c (push (cdr item) c))
123 (:d (push (cdr item) d))))
127 (labels ((check-list (list)
130 (when (= (first list) (1- (second list)))
131 (check-list (cdr list)))
132 (= (first list) (1- n))))))
133 (values (check-list (nreverse a))
134 (check-list (nreverse b))
135 (check-list (nreverse c))
136 (check-list (nreverse d))))))
144 (let ((q (make-queue))
146 (r (make-semaphore)))
151 (wait-on-semaphore w)
154 (multiple-value-bind (x ok) (dequeue q)
156 (if (and (> x last) ok)
158 (return (list last x ok))))
162 (return (list last x ok))))))))))
164 (list (make-thread #'dq)
167 (make-thread #'dq))))
168 (loop repeat 4 do (wait-on-semaphore r))
169 (signal-semaphore w 4)
170 (mapcar #'join-thread deschedulers))))
175 (let* ((q (make-queue))
180 (make-thread (lambda ()
182 (wait-on-semaphore w)
184 (enqueue (cons :a i) q))))
185 (make-thread (lambda ()
187 (wait-on-semaphore w)
189 (enqueue (cons :b i) q))))
190 (make-thread (lambda ()
192 (wait-on-semaphore w)
194 (enqueue (cons :c i) q))))
195 (make-thread (lambda ()
197 (wait-on-semaphore w)
199 (enqueue (cons :d i) q)))))))
210 (wait-on-semaphore w)
211 (loop (multiple-value-bind (item ok) (dequeue q)
213 (let ((n (cdr item)))
214 (macrolet ((test (name c)
227 (unless (or (some #'thread-alive-p schedulers)
228 (not (queue-empty-p q)))
229 (return (list a ac b bc c cc d dc))))))))))
230 (let ((deschedulers (list
234 (make-thread #'dq))))
235 (loop repeat 8 do (wait-on-semaphore r))
236 (signal-semaphore w 8)
246 (let ((results (join-thread th)))
248 (destructuring-bind (ta tac tb tbc tc tcc td tdc) results