changelog shortlog graph tags branches changeset file revisions annotate raw help

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

revision 692: f51b73f49946
parent 691: 295ea43ceb2d
child 694: a36280d2ef4e
     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+