improve tests; minor fixes on util/async

This commit is contained in:
Helmut Merz 2025-02-19 11:03:22 +01:00
parent a3efdcc63b
commit 22ddac033e
3 changed files with 15 additions and 15 deletions

View file

@ -14,7 +14,7 @@
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run #:user #:password)
(:import-from :scopes/testing #:deftest #:==))
(:import-from :scopes/testing #:deftest #:== #:!=))
(in-package :scopes/test-core)
@ -91,12 +91,12 @@
(== (async:status tsk) :running)
(async:stop tsk)
;(sleep 0.1)
(== (async:status tsk) :finished)
))
(== (async:status tsk) :done)))
(deftest test-util-crypt ()
(util:lgi (crypt:create-secret))
)
(let ((s1 (crypt:create-secret))
(s2 (crypt:create-secret)))
(!= s1 s2)))
(deftest test-util-iter ()
(let ((it (iter:list-iterator '(a b c))))
@ -106,16 +106,14 @@
(let ((it (iter:string-iterator "a b c")))
(== (iter:value it) nil)
(== (iter:next it) nil)
(== (string (iter:value it)) "A"))
)
(== (string (iter:value it)) "A")))
(deftest test-shape()
(let ((rec (make-instance 'shape:record :head '(:t1))))
(== (shape:head rec) '(:t1 nil))
(== (shape:head-value rec :taskid) :t1)
(setf (shape:head-value rec :username) :u1)
(== (shape:head-value rec :username) :u1)
))
(== (shape:head-value rec :username) :u1)))
(deftest test-send ()
(let ((rcvr (receiver t:*test-suite*))
@ -123,5 +121,4 @@
(msg-exp (message:create '(:test :dummy) :data "dummy payload")))
(expect rcvr msg-exp)
(== (core:name rcvr) :test-receiver)
(core:send rcvr msg)
))
(core:send rcvr msg)))

View file

@ -44,6 +44,9 @@
(defun == (have wanted)
(check #'equalp "~s!=~s" have wanted))
(defun != (have wanted)
(check #'(lambda (h w) (not (equalp h w))) "~s==~s" have wanted))
(defun has-prefix (have wanted)
(check #'(lambda (h w) (string= (str:prefix (list h w)) w))
"~s has not prefix ~s" have wanted))

View file

@ -5,8 +5,8 @@
(:local-nicknames (:util :scopes/util)
(:lp :lparallel)
(:lpq :lparallel.queue))
(:export #:task #:make-task #:start #:restart #:stop #:kill #:status #:logdata
#:mailbox #:send #:receive))
(:export #:task #:make-task #:start #:stop #:status #:logdata
#:mailbox #:send))
(in-package :scopes/util/async)
@ -31,8 +31,8 @@
until (eq msg +quit-message+)
do (funcall handle-message tsk msg)))
(funcall teardown tsk))
(setf (status tsk) :finished)
"done")))
(setf (status tsk) :done)
(logdata tsk))))
;;;; task class and related functions / methods