contrib/sb-concurrency/tests/test-queue.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   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.
   8
   9 (in-package :sb-concurrency-test)
  10
  11 (deftest queue.1
  12     (let ((q (make-queue :name 'test-q :initial-contents '(1 2 3))))
  13       (enqueue 4 q)
  14       (values (queue-name q)
  15               (multiple-value-list (dequeue q))
  16               (list-queue-contents q)))
  17   test-q
  18   (1 t)
  19   (2 3 4))
  20
  21 (deftest queue.2
  22     (dequeue (make-queue))
  23   nil
  24   nil)
  25
  26 (deftest queue.3
  27     (dequeue (make-queue :initial-contents '(nil)))
  28   nil
  29   t)
  30
  31 (deftest queue.4
  32     (let ((x (make-instance 'structure-object))
  33           (y (make-queue)))
  34       ;; I wonder why I thought this needs testing?
  35       (values (typep x 'queue)
  36               (queuep x)
  37               (typep y 'queue)
  38               (queuep y)))
  39   nil nil t t)
  40
  41 (deftest queue.5
  42     (let ((q (make-queue :initial-contents (vector 1 2 3 4 5))))
  43       (values (= 5 (queue-count q))
  44               (enqueue 'foo q)
  45               (= 6 (queue-count q))
  46               (dequeue q)
  47               (= 5 (queue-count q))
  48               (dequeue q)
  49               (= 4 (queue-count q))
  50               (dequeue q)
  51               (= 3 (queue-count q))
  52               (dequeue q)
  53               (= 2 (queue-count q))
  54               (dequeue q)
  55               (= 1 (queue-count q))
  56               (not (queue-empty-p q))
  57               (dequeue q)
  58               (= 0 (queue-count q))
  59               (queue-empty-p q)
  60               (dequeue q)
  61               (= 0 (queue-count q))
  62               (queue-empty-p q)))
  63   t
  64   foo
  65   t
  66   1
  67   t
  68   2
  69   t
  70   3
  71   t
  72   4
  73   t
  74   5
  75   t
  76   t
  77   foo
  78   t
  79   t
  80   nil
  81   t
  82   t)
  83
  84 #+sb-thread
  85 (deftest queue.t.1
  86     (let* ((q (make-queue))
  87            (w (make-semaphore))
  88            (r (make-semaphore))
  89            (n 100000)
  90            (schedulers (list
  91                         (make-thread (lambda ()
  92                                        (signal-semaphore r)
  93                                        (wait-on-semaphore w)
  94                                        (dotimes (i n)
  95                                          (enqueue (cons :a i) q))))
  96                         (make-thread (lambda ()
  97                                        (signal-semaphore r)
  98                                        (wait-on-semaphore w)
  99                                        (dotimes (i n)
 100                                          (enqueue (cons :b i) q))))
 101                         (make-thread (lambda ()
 102                                        (signal-semaphore r)
 103                                        (wait-on-semaphore w)
 104                                        (dotimes (i n)
 105                                          (enqueue (cons :c i) q))))
 106                         (make-thread (lambda ()
 107                                        (signal-semaphore r)
 108                                        (wait-on-semaphore w)
 109                                        (dotimes (i n)
 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)
 114       (let (a b c d)
 115         (loop
 116           (multiple-value-bind (item ok) (dequeue q)
 117             (cond (item
 118                    (assert ok)
 119                    (case (car item)
 120                      (:a (push (cdr item) a))
 121                      (:b (push (cdr item) b))
 122                      (:c (push (cdr item) c))
 123                      (:d (push (cdr item) d))))
 124                   (t
 125                    (assert (not ok))
 126                    (return)))))
 127         (labels ((check-list (list)
 128                    (when list
 129                      (if (cdr 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))))))
 137   t
 138   t
 139   t
 140   t)
 141
 142 #+sb-thread
 143 (deftest queue.t.2
 144     (let ((q (make-queue))
 145           (w (make-semaphore))
 146           (r (make-semaphore)))
 147       (dotimes (i 1000000)
 148         (enqueue i q))
 149       (flet ((dq ()
 150                (signal-semaphore r)
 151                (wait-on-semaphore w)
 152                (let ((last -1))
 153                  (loop
 154                    (multiple-value-bind (x ok) (dequeue q)
 155                      (cond (x
 156                             (if (and (> x last) ok)
 157                                 (setf last x)
 158                                 (return (list last x ok))))
 159                            (t
 160                             (if (not ok)
 161                                 (return t)
 162                                 (return (list last x ok))))))))))
 163         (let ((deschedulers
 164                (list (make-thread #'dq)
 165                      (make-thread #'dq)
 166                      (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))))
 171   (t t t t))
 172
 173 #+sb-thread
 174 (deftest queue.t.3
 175     (let* ((q (make-queue))
 176            (w (make-semaphore))
 177            (r (make-semaphore))
 178            (n 100000)
 179            (schedulers (list
 180                         (make-thread (lambda ()
 181                                        (signal-semaphore r)
 182                                        (wait-on-semaphore w)
 183                                        (dotimes (i n)
 184                                          (enqueue (cons :a i) q))))
 185                         (make-thread (lambda ()
 186                                        (signal-semaphore r)
 187                                        (wait-on-semaphore w)
 188                                        (dotimes (i n)
 189                                          (enqueue (cons :b i) q))))
 190                         (make-thread (lambda ()
 191                                        (signal-semaphore r)
 192                                        (wait-on-semaphore w)
 193                                        (dotimes (i n)
 194                                          (enqueue (cons :c i) q))))
 195                         (make-thread (lambda ()
 196                                        (signal-semaphore r)
 197                                        (wait-on-semaphore w)
 198                                        (dotimes (i n)
 199                                          (enqueue (cons :d i) q)))))))
 200       (flet ((dq ()
 201                (let ((a -1)
 202                      (ac 0)
 203                      (b -1)
 204                      (bc 0)
 205                      (c -1)
 206                      (cc 0)
 207                      (d -1)
 208                      (dc 0))
 209                  (signal-semaphore r)
 210                  (wait-on-semaphore w)
 211                  (loop (multiple-value-bind (item ok) (dequeue q)
 212                          (cond (item
 213                                 (let ((n (cdr item)))
 214                                   (macrolet ((test (name c)
 215                                                `(if (< ,name n)
 216                                                     (progn
 217                                                       (setf ,name n)
 218                                                       (incf ,c))
 219                                                     (return nil))))
 220                                     (ecase (car item)
 221                                       (:a (test a ac))
 222                                       (:b (test b bc))
 223                                       (:c (test c cc))
 224                                       (:d (test d dc))))))
 225                                (t
 226                                 (assert (not ok))
 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
 231                              (make-thread #'dq)
 232                              (make-thread #'dq)
 233                              (make-thread #'dq)
 234                              (make-thread #'dq))))
 235           (loop repeat 8 do (wait-on-semaphore r))
 236           (signal-semaphore w 8)
 237           (let ((a -1)
 238                 (ac 0)
 239                 (b -1)
 240                 (bc 0)
 241                 (c -1)
 242                 (cc 0)
 243                 (d -1)
 244                 (dc 0))
 245             (mapc (lambda (th)
 246                     (let ((results (join-thread th)))
 247                       (when results
 248                         (destructuring-bind (ta tac tb tbc tc tcc td tdc) results
 249                           (setf a (max ta a)
 250                                 b (max tb b)
 251                                 c (max tc c)
 252                                 d (max td d))
 253                           (incf ac tac)
 254                           (incf bc tbc)
 255                           (incf cc tcc)
 256                           (incf dc tdc)))))
 257                   deschedulers)
 258             (and (= n ac (1+ a))
 259                  (= n bc (1+ b))
 260                  (= n cc (1+ c))
 261                  (= n dc (1+ d)))))))
 262   t)