tests/condition-notify.pure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2 (use-package "SB-THREAD")
   3
   4 ;;; A few remarks about this:
   5 ;;; 1) this test is quite strange/bad because it relies on luck and timing.
   6 ;;;    The linux FUTEX_WAIT manual entry says "wakes at most val of the waiters"
   7 ;;;    meaning 'val' is an upper bound on the count of awakened threads.
   8 ;;;    The kernel might decide to cap 'val' to the number of hardware threads,
   9 ;;;    as more threads can't be scheduled concurrently.
  10 ;;;    The lower bound on awakened threads is 1, without which there would literally
  11 ;;;    be no reason to call FUTEX_WAKE. So why does this test expect that all threads
  12 ;;;    are awakened? Because I think in practice the only cases the Linux kernel
  13 ;;;    actually implements are 1 and all.  I would guess that other OSes behave similarly.
  14 ;;;    Absence of any criterion guarded by the mutex makes this usage of a condition
  15 ;;;    var highly dubious in the first place, as normally any consumer of the event
  16 ;;;    signaled would be allowed to consume more than one event. Hence the validity
  17 ;;;    of waking fewer threads than 'val'.
  18 ;;;
  19 ;;; 2) win32 didn't always have #+sb-futex but now it does, so maybe this test should
  20 ;;;    pass there. However I tried it once (and only once) and got
  21 ;;;    "LEFTOVER-THREAD" from the test runner, which is a different problem.
  22 ;;;    TERMINATE-THREAD is horrible. Some win32 contributor will have to fix this
  23 ;;;    by making the test have a better termination criterion.
  24 ;;;
  25 ;;; When executed on macOS, each waiter tends to (or does) print its output message
  26 ;;; exactly once, but on Linux I've seen threads print more than once, which
  27 ;;; unquestionably indicates spurious wakeup.
  28 (defparameter nthreads 10)
  29 (with-test (:name (:condition-variable :notify-multiple)
  30                   :broken-on :win32)
  31   (flet ((tester (name notify-fun)
  32            (format t "~&Exercising ~A~%" name)
  33            (let ((queue (make-waitqueue :name "queue"))
  34                  (lock (make-mutex :name "lock"))
  35                  (start-sem (make-semaphore))
  36                  (waiting (1- (ash 1 nthreads))))
  37              (labels ((test (x &aux signaled-start-sem)
  38                         ;; This is an extremely atypical (dare I say "bogus") use of cv-wait
  39                         ;; in that there is no concrete test that it is waiting to satisfy.
  40                         ;; So it can't distinguish spurious wakeup from being signaled
  41                         ;; which sort of negates the very purpose of the test.
  42                         (loop
  43                          (let ((initial-waiting 0))
  44                            (with-mutex (lock)
  45                              (setq initial-waiting waiting)
  46                              ;; (format t "condition-wait ~a~%" x) (force-output)
  47                              (unless signaled-start-sem
  48                                (signal-semaphore start-sem)
  49                                (setq signaled-start-sem t))
  50                              (condition-wait queue lock)
  51                              ;; clear my bit. mutext is held, so this is safe
  52                              (setf waiting (logandc2 waiting (ash 1 x))))
  53                            ;; for any given thread, say that its bit was cleared once only
  54                            ;; (to try to see any problems)
  55                            ;; This can be outside the lock, but try to issue a single write()
  56                            ;; to avoid interleaved output.
  57                            (let ((str (format nil "worker ~a got cv notification (repeated=~D)~%" x
  58                                               (not (logbitp x initial-waiting)))))
  59                              (sb-sys:with-pinned-objects (str)
  60                                (sb-unix:unix-write 2 str 0 (length str))))))))
  61                (let ((threads (loop for x from 0 below (integer-length waiting)
  62                                     collect (make-kill-thread
  63                                              #'test :arguments (list x)
  64                                              :name (format nil "worker~D" x)))))
  65                  (wait-on-semaphore start-sem :n nthreads)
  66                  (format t "~&All threads indicate ready~%")
  67                  (with-mutex (lock)
  68                    (funcall notify-fun queue))
  69                  ;; give a few seconds for every thread to decide that it was woken,
  70                  ;; and stop as soon as they all are
  71                  (loop repeat 30
  72                        do (when (zerop waiting) (return))
  73                           (sleep .1))
  74                  (mapcar #'terminate-thread threads)
  75                  ;; Check that all threads woke up at least once
  76                  (assert (zerop waiting)))))))
  77     ;; the BROADCAST test is reasonable, the NOTIFY test is not.
  78     (tester "condition-broadcast"
  79             (lambda (queue) (condition-broadcast queue)))
  80     (tester "condition-notify"
  81             (lambda (queue) (condition-notify queue nthreads)))))