-(let* ((q (make-queue))
- (w (make-semaphore))
- (r (make-semaphore))
- (n 100000)
- (schedulers (list
- (make-thread (lambda ()
- (signal-semaphore r)
- (wait-on-semaphore w)
- (dotimes (i n)
- (enqueue (cons :a i) q))))
- (make-thread (lambda ()
- (signal-semaphore r)
- (wait-on-semaphore w)
- (dotimes (i n)
- (enqueue (cons :b i) q))))
- (make-thread (lambda ()
- (signal-semaphore r)
- (wait-on-semaphore w)
- (dotimes (i n)
- (enqueue (cons :c i) q))))
- (make-thread (lambda ()
- (signal-semaphore r)
- (wait-on-semaphore w)
- (dotimes (i n)
- (enqueue (cons :d i) q)))))))
- (loop repeat 4 do (wait-on-semaphore r))
- (signal-semaphore w 4)
- (mapc #'join-thread schedulers)
- (let (a b c d)
- (loop
- (multiple-value-bind (item ok) (dequeue q)
- (cond (item
- (assert ok)
- (case (car item)
- (:a (push (cdr item) a))
- (:b (push (cdr item) b))
- (:c (push (cdr item) c))
- (:d (push (cdr item) d))))
- (t
- (assert (not ok))
- (return)))))
- (labels ((check-list (list)
- (when list
- (if (cdr list)
- (when (= (first list) (1- (second list)))
- (check-list (cdr list)))
- (= (first list) (1- n))))))
- (assert (eq t (check-list (nreverse a))))
- (assert (eq t (check-list (nreverse b))))
- (assert (eq t (check-list (nreverse c))))
- (assert (eq t (check-list (nreverse d)))))))
+(deftest queue.t.1
+ (let* ((q (make-queue))
+ (w (make-semaphore))
+ (r (make-semaphore))
+ (n 100000)
+ (schedulers (list
+ (make-thread (lambda ()
+ (signal-semaphore r)
+ (wait-on-semaphore w)
+ (dotimes (i n)
+ (enqueue (cons :a i) q))))
+ (make-thread (lambda ()
+ (signal-semaphore r)
+ (wait-on-semaphore w)
+ (dotimes (i n)
+ (enqueue (cons :b i) q))))
+ (make-thread (lambda ()
+ (signal-semaphore r)
+ (wait-on-semaphore w)
+ (dotimes (i n)
+ (enqueue (cons :c i) q))))
+ (make-thread (lambda ()
+ (signal-semaphore r)
+ (wait-on-semaphore w)
+ (dotimes (i n)
+ (enqueue (cons :d i) q)))))))
+ (loop repeat 4 do (wait-on-semaphore r))
+ (signal-semaphore w 4)
+ (mapc #'join-thread schedulers)
+ (let (a b c d)
+ (loop
+ (multiple-value-bind (item ok) (dequeue q)
+ (cond (item
+ (assert ok)
+ (case (car item)
+ (:a (push (cdr item) a))
+ (:b (push (cdr item) b))
+ (:c (push (cdr item) c))
+ (:d (push (cdr item) d))))
+ (t
+ (assert (not ok))
+ (return)))))
+ (labels ((check-list (list)
+ (when list
+ (if (cdr list)
+ (when (= (first list) (1- (second list)))
+ (check-list (cdr list)))
+ (= (first list) (1- n))))))
+ (values (check-list (nreverse a))
+ (check-list (nreverse b))
+ (check-list (nreverse c))
+ (check-list (nreverse d))))))
+ t
+ t
+ t
+ t)