+(assert (eql 1 (length (list-all-threads))))
+
+(assert (eq *current-thread*
+ (find (thread-name *current-thread*) (list-all-threads)
+ :key #'thread-name :test #'equal)))
+
+(assert (thread-alive-p *current-thread*))
+
+(let ((a 0))
+ (interrupt-thread *current-thread* (lambda () (setq a 1)))
+ (assert (eql a 1)))
+
+(let ((spinlock (make-spinlock)))
+ (with-spinlock (spinlock)))
+
+(let ((mutex (make-mutex)))
+ (with-mutex (mutex)
+ mutex))
+
+#-sb-thread (sb-ext:quit :unix-status 104)
+
+(let ((old-threads (list-all-threads))
+ (thread (make-thread (lambda ()
+ (assert (find *current-thread* *all-threads*))
+ (sleep 2))))
+ (new-threads (list-all-threads)))
+ (assert (thread-alive-p thread))
+ (assert (eq thread (first new-threads)))
+ (assert (= (1+ (length old-threads)) (length new-threads)))
+ (sleep 3)
+ (assert (not (thread-alive-p thread))))
+
+;;; We had appalling scaling properties for a while. Make sure they
+;;; don't reappear.
+(defun scaling-test (function &optional (nthreads 5))
+ "Execute FUNCTION with NTHREADS lurking to slow it down."
+ (let ((queue (sb-thread:make-waitqueue))
+ (mutex (sb-thread:make-mutex)))
+ ;; Start NTHREADS idle threads.
+ (dotimes (i nthreads)
+ (sb-thread:make-thread (lambda ()
+ (sb-thread:condition-wait queue mutex)
+ (sb-ext:quit))))
+ (let ((start-time (get-internal-run-time)))
+ (funcall function)
+ (prog1 (- (get-internal-run-time) start-time)
+ (sb-thread:condition-broadcast queue)))))
+(defun fact (n)
+ "A function that does work with the CPU."
+ (if (zerop n) 1 (* n (fact (1- n)))))
+(let ((work (lambda () (fact 15000))))
+ (let ((zero (scaling-test work 0))
+ (four (scaling-test work 4)))
+ ;; a slightly weak assertion, but good enough for starters.
+ (assert (< four (* 1.5 zero)))))
+