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 (defpackage :sb-queue-test
10 (:use :cl :sb-thread :sb-queue :sb-rt)
13 (in-package :sb-queue-test)
16 (let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
18 (values (queue-name q)
19 (multiple-value-list (dequeue q))
20 (list-queue-contents q)))
26 (dequeue (make-queue))
31 (dequeue (make-queue :initial-contents '(nil)))
36 (let ((x (make-instance 'structure-object))
38 ;; I wonder why I thought this needs testing?
39 (values (typep x 'queue)
46 (let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
47 (values (= 5 (queue-count q))
60 (not (queue-empty-p q))
90 (let* ((q (make-queue))
95 (make-thread (lambda ()
99 (enqueue (cons :a i) q))))
100 (make-thread (lambda ()
102 (wait-on-semaphore w)
104 (enqueue (cons :b i) q))))
105 (make-thread (lambda ()
107 (wait-on-semaphore w)
109 (enqueue (cons :c i) q))))
110 (make-thread (lambda ()
112 (wait-on-semaphore w)
114 (enqueue (cons :d i) q)))))))
115 (loop repeat 4 do (wait-on-semaphore r))
116 (signal-semaphore w 4)
117 (mapc #'join-thread schedulers)
120 (multiple-value-bind (item ok) (dequeue q)
124 (:a (push (cdr item) a))
125 (:b (push (cdr item) b))
126 (:c (push (cdr item) c))
127 (:d (push (cdr item) d))))
131 (labels ((check-list (list)
134 (when (= (first list) (1- (second list)))
135 (check-list (cdr list)))
136 (= (first list) (1- n))))))
137 (values (check-list (nreverse a))
138 (check-list (nreverse b))
139 (check-list (nreverse c))
140 (check-list (nreverse d))))))
148 (let ((q (make-queue))
150 (r (make-semaphore)))
155 (wait-on-semaphore w)
158 (multiple-value-bind (x ok) (dequeue q)
160 (if (and (> x last) ok)
162 (return (list last x ok))))
166 (return (list last x ok))))))))))
168 (list (make-thread #'dq)
171 (make-thread #'dq))))
172 (loop repeat 4 do (wait-on-semaphore r))
173 (signal-semaphore w 4)
174 (mapcar #'join-thread deschedulers))))
179 (let* ((q (make-queue))
184 (make-thread (lambda ()
186 (wait-on-semaphore w)
188 (enqueue (cons :a i) q))))
189 (make-thread (lambda ()
191 (wait-on-semaphore w)
193 (enqueue (cons :b i) q))))
194 (make-thread (lambda ()
196 (wait-on-semaphore w)
198 (enqueue (cons :c i) q))))
199 (make-thread (lambda ()
201 (wait-on-semaphore w)
203 (enqueue (cons :d i) q)))))))
214 (wait-on-semaphore w)
215 (loop (multiple-value-bind (item ok) (dequeue q)
217 (let ((n (cdr item)))
218 (macrolet ((test (name c)
231 (unless (or (some #'thread-alive-p schedulers)
232 (not (queue-empty-p q)))
233 (return (list a ac b bc c cc d dc))))))))))
234 (let ((deschedulers (list
238 (make-thread #'dq))))
239 (loop repeat 8 do (wait-on-semaphore r))
240 (signal-semaphore w 8)
250 (let ((results (join-thread th)))
252 (destructuring-bind (ta tac tb tbc tc tcc td tdc) results