cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

core/async: + test (and fixes) for working with mailbox / handle-message

Browse source
This commit is contained in:
Helmut Merz 2025-02-19 17:50:18 +01:00
parent 22ddac033e
commit 7e1bfd9f48
2 changed files with 15 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
test/test-core.lisp
View file

@ -90,8 +90,16 @@
(async:start tsk) (async:start tsk)
(== (async:status tsk) :running) (== (async:status tsk) :running)
(async:stop tsk) (async:stop tsk)
;(sleep 0.1) (== (async:status tsk) :done))
(== (async:status tsk) :done))) (let ((tsk (async:make-task :handle-message
#'(lambda (tsk msg) (push msg (async:data tsk))))))
(== (async:status tsk) :new)
(async:start tsk)
(== (async:status tsk) :running)
(async:send tsk :hello)
(== (async:stop tsk) '(:hello))
(== (async:status tsk) :done)
))
(deftest test-util-crypt () (deftest test-util-crypt ()
(let ((s1 (crypt:create-secret)) (let ((s1 (crypt:create-secret))

10
util/async.lisp
View file

@ -5,8 +5,7 @@
(:local-nicknames (:util :scopes/util) (:local-nicknames (:util :scopes/util)
(:lp :lparallel) (:lp :lparallel)
(:lpq :lparallel.queue)) (:lpq :lparallel.queue))
(:export #:task #:make-task #:start #:stop #:status #:logdata (:export #:task #:make-task #:start #:stop #:status #:data #:send))
#:mailbox #:send))
(in-package :scopes/util/async) (in-package :scopes/util/async)
@ -30,9 +29,10 @@
(loop for msg = (lpq:pop-queue mb) (loop for msg = (lpq:pop-queue mb)
until (eq msg +quit-message+) until (eq msg +quit-message+)
do (funcall handle-message tsk msg))) do (funcall handle-message tsk msg)))
(funcall teardown tsk)) (funcall teardown tsk)
(data tsk))
(setf (status tsk) :done) (setf (status tsk) :done)
(logdata tsk)))) )))
;;;; task class and related functions / methods ;;;; task class and related functions / methods
@ -42,7 +42,7 @@
(channel :reader channel :initform (lp:make-channel)) (channel :reader channel :initform (lp:make-channel))
(mailbox :accessor mailbox :initform nil) (mailbox :accessor mailbox :initform nil)
(status :accessor status :initform :new) (status :accessor status :initform :new)
(logdata :accessor logdata :initform nil))) (data :accessor data :initform nil)))
(defun make-task (&key (startup #'noop) (teardown #'noop) handle-message) (defun make-task (&key (startup #'noop) (teardown #'noop) handle-message)
(let ((tsk (make-instance 'task))) (let ((tsk (make-instance 'task)))