X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-queue%2Ftest-queue.lisp;h=48b7b62760a638a17f560145f1001792b0f2264a;hb=371577a214ce2659c271279ad48e4c42e1c0c93e;hp=3a0b2a507fbf7a9ccb2a02b9f48397b77e6330a7;hpb=95d19447c10434753c2168ac943152fd5e3ded3d;p=sbcl.git

diff --git a/contrib/sb-queue/test-queue.lisp b/contrib/sb-queue/test-queue.lisp
index 3a0b2a5..48b7b62 100644
--- a/contrib/sb-queue/test-queue.lisp
+++ b/contrib/sb-queue/test-queue.lisp
@@ -1,107 +1,151 @@
-(require :sb-queue)
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was written at
+;;;; Carnegie Mellon University and released into the public domain. The
+;;;; software is in the public domain and is provided with absolutely no
+;;;; warranty. See the COPYING and CREDITS files for more information.
 
 (defpackage :sb-queue-test
-  (:use :cl :sb-thread :sb-queue)
+  (:use :cl :sb-thread :sb-queue :sb-rt)
   (:export))
 
 (in-package :sb-queue-test)
 
-(let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
-  (enqueue 4 q)
-  (assert (eq 'test-q (queue-name q)))
-  (multiple-value-bind (v ok) (dequeue q)
-    (assert (eql 1 v))
-    (assert (eq t ok)))
-  (assert (equal (list-queue-contents q) (list 2 3 4))))
+(deftest queue.1
+    (let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
+      (enqueue 4 q)
+      (values (queue-name q)
+              (multiple-value-list (dequeue q))
+              (list-queue-contents q)))
+  test-q
+  (1 t)
+  (2 3 4))
 
-(assert (equal (list nil nil) (multiple-value-list (dequeue (make-queue)))))
+(deftest queue.2
+    (dequeue (make-queue))
+  nil
+  nil)
 
-(assert (equal (list nil t) (multiple-value-list (dequeue (make-queue :initial-contents '(nil))))))
+(deftest queue.3
+    (dequeue (make-queue :initial-contents '(nil)))
+  nil
+  t)
 
-(let ((x (make-instance 'structure-object))
-      (y (make-queue)))
-  (assert (not (typep x 'queue)))
-  (assert (not (queuep x)))
-  (assert (typep y 'queue))
-  (assert (queuep y)))
+(deftest queue.4
+    (let ((x (make-instance 'structure-object))
+          (y (make-queue)))
+      ;; I wonder why I thought this needs testing?
+      (values (typep x 'queue)
+              (queuep x)
+              (typep y 'queue)
+              (queuep y)))
+  nil nil t t)
 
-(let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
-  (assert (= 5 (queue-count q)))
-  (enqueue 'foo q)
-  (assert (= 6 (queue-count q)))
-  (dequeue q)
-  (assert (= 5 (queue-count q)))
-  (dequeue q)
-  (assert (= 4 (queue-count q)))
-  (dequeue q)
-  (assert (= 3 (queue-count q)))
-  (dequeue q)
-  (assert (= 2 (queue-count q)))
-  (dequeue q)
-  (assert (= 1 (queue-count q)))
-  (assert (not (queue-empty-p q)))
-  (dequeue q)
-  (assert (= 0 (queue-count q)))
-  (assert (queue-empty-p q))
-  (dequeue q)
-  (assert (= 0 (queue-count q)))
-  (assert (queue-empty-p q)))
+(deftest queue.5
+    (let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
+      (values (= 5 (queue-count q))
+              (enqueue 'foo q)
+              (= 6 (queue-count q))
+              (dequeue q)
+              (= 5 (queue-count q))
+              (dequeue q)
+              (= 4 (queue-count q))
+              (dequeue q)
+              (= 3 (queue-count q))
+              (dequeue q)
+              (= 2 (queue-count q))
+              (dequeue q)
+              (= 1 (queue-count q))
+              (not (queue-empty-p q))
+              (dequeue q)
+              (= 0 (queue-count q))
+              (queue-empty-p q)
+              (dequeue q)
+              (= 0 (queue-count q))
+              (queue-empty-p q)))
+  t
+  foo
+  t
+  1
+  t
+  2
+  t
+  3
+  t
+  4
+  t
+  5
+  t
+  t
+  foo
+  t
+  t
+  nil
+  t
+  t)
 
 #+sb-thread
-(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)
 
 #+sb-thread
-(let ((q (make-queue))
+(deftest queue.t.2
+    (let ((q (make-queue))
           (w (make-semaphore))
           (r (make-semaphore)))
       (dotimes (i 1000000)
@@ -127,98 +171,96 @@
                      (make-thread #'dq))))
           (loop repeat 4 do (wait-on-semaphore r))
           (signal-semaphore w 4)
-          (mapcar (lambda (th)
-                    (assert (eq t (join-thread th))))
-                  deschedulers))))
+          (mapcar #'join-thread deschedulers))))
+  (t t t t))
 
 #+sb-thread
-(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)))))))
-  (flet ((dq ()
-           (let ((a -1)
-                 (ac 0)
-                 (b -1)
-                 (bc 0)
-                 (c -1)
-                 (cc 0)
-                 (d -1)
-                 (dc 0))
-             (signal-semaphore r)
-             (wait-on-semaphore w)
-             (loop (multiple-value-bind (item ok) (dequeue q)
-                     (cond (item
-                            (let ((n (cdr item)))
-                              (macrolet ((test (name c)
-                                           `(if (< ,name n)
-                                                (progn
-                                                  (setf ,name n)
-                                                  (incf ,c))
-                                                (return nil))))
-                                (ecase (car item)
-                                  (:a (test a ac))
-                                  (:b (test b bc))
-                                  (:c (test c cc))
-                                  (:d (test d dc))))))
-                           (t
-                            (assert (not ok))
-                            (unless (or (some #'thread-alive-p schedulers)
-                                        (not (queue-empty-p q)))
-                              (return (list a ac b bc c cc d dc))))))))))
-    (let ((deschedulers (list
-                         (make-thread #'dq)
-                         (make-thread #'dq)
-                         (make-thread #'dq)
-                         (make-thread #'dq))))
-      (loop repeat 8 do (wait-on-semaphore r))
-      (signal-semaphore w 8)
-      (let ((a -1)
-            (ac 0)
-            (b -1)
-            (bc 0)
-            (c -1)
-            (cc 0)
-            (d -1)
-            (dc 0))
-        (mapc (lambda (th)
-                (let ((results (join-thread th)))
-                  (when results
-                    (destructuring-bind (ta tac tb tbc tc tcc td tdc) results
-                      (setf a (max ta a)
-                            b (max tb b)
-                            c (max tc c)
-                            d (max td d))
-                      (incf ac tac)
-                      (incf bc tbc)
-                      (incf cc tcc)
-                      (incf dc tdc)))))
-              deschedulers)
-        (assert (and (= n ac (1+ a))
-                     (= n bc (1+ b))
-                     (= n cc (1+ c))
-                     (= n dc (1+ d))))))))
-
-;;;; Unix success convention for exit codes
-(sb-ext:quit :unix-status 0)
+(deftest queue.t.3
+    (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)))))))
+      (flet ((dq ()
+               (let ((a -1)
+                     (ac 0)
+                     (b -1)
+                     (bc 0)
+                     (c -1)
+                     (cc 0)
+                     (d -1)
+                     (dc 0))
+                 (signal-semaphore r)
+                 (wait-on-semaphore w)
+                 (loop (multiple-value-bind (item ok) (dequeue q)
+                         (cond (item
+                                (let ((n (cdr item)))
+                                  (macrolet ((test (name c)
+                                               `(if (< ,name n)
+                                                    (progn
+                                                      (setf ,name n)
+                                                      (incf ,c))
+                                                    (return nil))))
+                                    (ecase (car item)
+                                      (:a (test a ac))
+                                      (:b (test b bc))
+                                      (:c (test c cc))
+                                      (:d (test d dc))))))
+                               (t
+                                (assert (not ok))
+                                (unless (or (some #'thread-alive-p schedulers)
+                                            (not (queue-empty-p q)))
+                                  (return (list a ac b bc c cc d dc))))))))))
+        (let ((deschedulers (list
+                             (make-thread #'dq)
+                             (make-thread #'dq)
+                             (make-thread #'dq)
+                             (make-thread #'dq))))
+          (loop repeat 8 do (wait-on-semaphore r))
+          (signal-semaphore w 8)
+          (let ((a -1)
+                (ac 0)
+                (b -1)
+                (bc 0)
+                (c -1)
+                (cc 0)
+                (d -1)
+                (dc 0))
+            (mapc (lambda (th)
+                    (let ((results (join-thread th)))
+                      (when results
+                        (destructuring-bind (ta tac tb tbc tc tcc td tdc) results
+                          (setf a (max ta a)
+                                b (max tb b)
+                                c (max tc c)
+                                d (max td d))
+                          (incf ac tac)
+                          (incf bc tbc)
+                          (incf cc tcc)
+                          (incf dc tdc)))))
+                  deschedulers)
+            (and (= n ac (1+ a))
+                 (= n bc (1+ b))
+                 (= n cc (1+ c))
+                 (= n dc (1+ d)))))))
+  t)