1.1--- a/lisp/std/tests/task.lisp Tue Oct 01 23:34:01 2024 -0400
1.2+++ b/lisp/std/tests/task.lisp Wed Oct 02 23:39:07 2024 -0400
1.3@@ -8,12 +8,14 @@
1.4
1.5 (deftest tasks ()
1.6 "Test task-pools, oracles, and workers."
1.7- (let ((pool (designate-oracle (make-task-pool) (make-oracle *current-thread*))))
1.8- ;; pool is bound to a task pool, *ORACLE-THREADS* contains the *CURRENT-THREAD*.
1.9- (spawn-workers pool 16)
1.10- ;; (with-threads (16 :args (&optional (a 0) (b 1) (c 2)))
1.11- ;; (sb-thread:allocator-histogram)
1.12- ;; (sb-concurrency:wait-on-gate (std/thread::task-pool-online pool))
1.13- ;; (print (+ a b c)))
1.14- (is (= 16 (length (task-pool-workers pool))))
1.15- (is (sb-thread:semaphore-count (std/task::task-pool-online pool)))))
1.16+ (with-threads (4 :args (&optional (a 0) (b 1) (c 2)))
1.17+ (is (= 3 (+ a b c))))
1.18+ ;; *ORACLE-THREADS* contains the *CURRENT-THREAD*.
1.19+ (std/task:with-task-pool (tp :count 10 :spawn 4)
1.20+ (is (= 4 (length (task-pool-workers tp))))
1.21+ (std/task::task-pool-lock tp)
1.22+ (is (= 4 (std/task::mailbox-count (task-pool-results tp))))
1.23+ (describe tp)
1.24+ (dotimes (i 4)
1.25+ (is (eql t (std/task::receive-message (task-pool-results tp)))))
1.26+ (is (null (std/task::receive-message-no-hang (task-pool-results tp))))))