(in-package "SB-THREAD") ; this is white-box testing, really
+;;; 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)))))
+
;;; For one of the interupt-thread tests, we want a foreign function
;;; that does not make syscalls
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.12.36"
+"0.8.12.37"