changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/std/tests/task.lisp

revision 691: 295ea43ceb2d
parent 563: 8b10eabe89dd
child 692: f51b73f49946
     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))))))