3 (defpackage :sb-queue-test
4 (:use :cl :sb-thread :sb-queue)
7 (in-package :sb-queue-test)
9 (let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
11 (assert (eq 'test-q (queue-name q)))
12 (multiple-value-bind (v ok) (dequeue q)
15 (assert (equal (list-queue-contents q) (list 2 3 4))))
17 (assert (equal (list nil nil) (multiple-value-list (dequeue (make-queue)))))
19 (assert (equal (list nil t) (multiple-value-list (dequeue (make-queue :initial-contents '(nil))))))
21 (let ((x (make-instance 'structure-object))
23 (assert (not (typep x 'queue)))
24 (assert (not (queuep x)))
25 (assert (typep y 'queue))
28 (let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
29 (assert (= 5 (queue-count q)))
31 (assert (= 6 (queue-count q)))
33 (assert (= 5 (queue-count q)))
35 (assert (= 4 (queue-count q)))
37 (assert (= 3 (queue-count q)))
39 (assert (= 2 (queue-count q)))
41 (assert (= 1 (queue-count q)))
42 (assert (not (queue-empty-p q)))
44 (assert (= 0 (queue-count q)))
45 (assert (queue-empty-p q))
47 (assert (= 0 (queue-count q)))
48 (assert (queue-empty-p q)))
51 (let* ((q (make-queue))
56 (make-thread (lambda ()
60 (enqueue (cons :a i) q))))
61 (make-thread (lambda ()
65 (enqueue (cons :b i) q))))
66 (make-thread (lambda ()
70 (enqueue (cons :c i) q))))
71 (make-thread (lambda ()
75 (enqueue (cons :d i) q)))))))
76 (loop repeat 4 do (wait-on-semaphore r))
77 (signal-semaphore w 4)
78 (mapc #'join-thread schedulers)
81 (multiple-value-bind (item ok) (dequeue q)
85 (:a (push (cdr item) a))
86 (:b (push (cdr item) b))
87 (:c (push (cdr item) c))
88 (:d (push (cdr item) d))))
92 (labels ((check-list (list)
95 (when (= (first list) (1- (second list)))
96 (check-list (cdr list)))
97 (= (first list) (1- n))))))
98 (assert (eq t (check-list (nreverse a))))
99 (assert (eq t (check-list (nreverse b))))
100 (assert (eq t (check-list (nreverse c))))
101 (assert (eq t (check-list (nreverse d)))))))
104 (let ((q (make-queue))
106 (r (make-semaphore)))
111 (wait-on-semaphore w)
114 (multiple-value-bind (x ok) (dequeue q)
116 (if (and (> x last) ok)
118 (return (list last x ok))))
122 (return (list last x ok))))))))))
124 (list (make-thread #'dq)
127 (make-thread #'dq))))
128 (loop repeat 4 do (wait-on-semaphore r))
129 (signal-semaphore w 4)
131 (assert (eq t (join-thread th))))
135 (let* ((q (make-queue))
140 (make-thread (lambda ()
142 (wait-on-semaphore w)
144 (enqueue (cons :a i) q))))
145 (make-thread (lambda ()
147 (wait-on-semaphore w)
149 (enqueue (cons :b i) q))))
150 (make-thread (lambda ()
152 (wait-on-semaphore w)
154 (enqueue (cons :c i) q))))
155 (make-thread (lambda ()
157 (wait-on-semaphore w)
159 (enqueue (cons :d i) q)))))))
170 (wait-on-semaphore w)
171 (loop (multiple-value-bind (item ok) (dequeue q)
173 (let ((n (cdr item)))
174 (macrolet ((test (name c)
187 (unless (or (some #'thread-alive-p schedulers)
188 (not (queue-empty-p q)))
189 (return (list a ac b bc c cc d dc))))))))))
190 (let ((deschedulers (list
194 (make-thread #'dq))))
195 (loop repeat 8 do (wait-on-semaphore r))
196 (signal-semaphore w 8)
206 (let ((results (join-thread th)))
208 (destructuring-bind (ta tac tb tbc tc tcc td tdc) results
218 (assert (and (= n ac (1+ a))
221 (= n dc (1+ d))))))))
223 ;;;; Unix success convention for exit codes
224 (sb-ext:quit :unix-status 0)