(use-package :test-util)
+(with-test (:name mutex-owner)
+ ;; Make sure basics are sane on unithreaded ports as well
+ (let ((mutex (make-mutex)))
+ (get-mutex mutex)
+ (assert (eq *current-thread* (mutex-value mutex)))
+ (handler-bind ((warning #'error))
+ (release-mutex mutex))
+ (assert (not (mutex-value mutex)))))
+
+(with-test (:name spinlock-owner)
+ ;; Make sure basics are sane on unithreaded ports as well
+ (let ((spinlock (sb-thread::make-spinlock)))
+ (sb-thread::get-spinlock spinlock)
+ (assert (eq *current-thread* (sb-thread::spinlock-value spinlock)))
+ (handler-bind ((warning #'error))
+ (sb-thread::release-spinlock spinlock))
+ (assert (not (sb-thread::spinlock-value spinlock)))))
+
;;; Terminating a thread that's waiting for the terminal.
#+sb-thread
(setf oops t))))))))
(mapcar #'sb-thread:join-thread threads)
(assert (not oops))))
+
+#+sb-thread
+(with-test (:name :semaphore-multiple-waiters)
+ (let ((semaphore (make-semaphore :name "test sem")))
+ (labels ((make-readers (n i)
+ (values
+ (loop for r from 0 below n
+ collect
+ (sb-thread:make-thread
+ (lambda ()
+ (let ((sem semaphore))
+ (dotimes (s i)
+ (sb-thread:wait-on-semaphore sem))))
+ :name "reader"))
+ (* n i)))
+ (make-writers (n readers i)
+ (let ((j (* readers i)))
+ (multiple-value-bind (k rem) (truncate j n)
+ (values
+ (let ((writers
+ (loop for w from 0 below n
+ collect
+ (sb-thread:make-thread
+ (lambda ()
+ (let ((sem semaphore))
+ (dotimes (s k)
+ (sb-thread:signal-semaphore sem))))
+ :name "writer"))))
+ (assert (zerop rem))
+ writers)
+ (+ rem (* n k))))))
+ (test (r w n)
+ (multiple-value-bind (readers x) (make-readers r n)
+ (assert (= (length readers) r))
+ (multiple-value-bind (writers y) (make-writers w r n)
+ (assert (= (length writers) w))
+ (assert (= x y))
+ (mapc #'sb-thread:join-thread writers)
+ (mapc #'sb-thread:join-thread readers)
+ (assert (zerop (sb-thread:semaphore-count semaphore)))
+ (values)))))
+ (assert
+ (eq :ok
+ (handler-case
+ (sb-ext:with-timeout 10
+ (test 1 1 100)
+ (test 2 2 10000)
+ (test 4 2 10000)
+ (test 4 2 10000)
+ (test 10 10 10000)
+ (test 10 1 10000)
+ :ok)
+ (sb-ext:timeout ()
+ :timeout)))))))
+