1.1--- a/lisp/std/tests/task.lisp Wed Oct 02 23:39:07 2024 -0400
1.2+++ b/lisp/std/tests/task.lisp Thu Oct 03 17:56:11 2024 -0400
1.3@@ -6,16 +6,20 @@
1.4 (in-package :std/tests)
1.5 (in-suite :std)
1.6
1.7-(deftest tasks ()
1.8- "Test task-pools, oracles, and workers."
1.9- (with-threads (4 :args (&optional (a 0) (b 1) (c 2)))
1.10- (is (= 3 (+ a b c))))
1.11- ;; *ORACLE-THREADS* contains the *CURRENT-THREAD*.
1.12- (std/task:with-task-pool (tp :count 10 :spawn 4)
1.13+(deftest task-pool ()
1.14+ "Task Pool tests."
1.15+ (with-task-pool (tp :workers 4 :tasks 10 :start t)
1.16 (is (= 4 (length (task-pool-workers tp))))
1.17- (std/task::task-pool-lock tp)
1.18- (is (= 4 (std/task::mailbox-count (task-pool-results tp))))
1.19- (describe tp)
1.20+ (is (> (std/task::mailbox-count (task-pool-results tp)) 0))
1.21 (dotimes (i 4)
1.22- (is (eql t (std/task::receive-message (task-pool-results tp)))))
1.23- (is (null (std/task::receive-message-no-hang (task-pool-results tp))))))
1.24+ (is (null (std/task::receive-message (task-pool-results tp)))))
1.25+ (is (null (std/task::receive-message-no-hang (task-pool-results tp))))
1.26+ (kill-workers tp)
1.27+ (is (zerop (worker-count tp))))
1.28+ (with-task-pool (tp :workers 4 :tasks 4 :start nil)
1.29+ (is (zerop (sb-concurrency:mailbox-count (results tp))))
1.30+ (start-task-workers tp)
1.31+ (loop for w across (workers tp)
1.32+ do (join-worker w))
1.33+ (is (= 4 (sb-concurrency:mailbox-count (results tp))))))
1.34+