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

test-core: add collected attribute for collecting (and later checking) messages

Browse source
This commit is contained in:
Helmut Merz 2026-10-06 15:55:58 +02:00
parent 534404d977
commit d21c766939
2 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
test/test-core.lisp
View file

@ -17,7 +17,7 @@
(:t :scopes/testing)) (:t :scopes/testing))
(:export #:run #:user #:password (:export #:run #:user #:password
#:test-receiver #:receiver #:suite #:test-receiver #:receiver #:suite
#:expect #:check-message #:check-expected #:collect #:collected #:expect #:check-message #:check-expected
#:setup #:test-suite) #:setup #:test-suite)
(:import-from :scopes/testing #:deftest #:== #:!=)) (:import-from :scopes/testing #:deftest #:== #:!=))
@ -27,6 +27,7 @@
(defclass test-receiver (core:context) (defclass test-receiver (core:context)
((suite :reader suite :initarg :suite) ((suite :reader suite :initarg :suite)
(collected :accessor collected :initform nil)
(expected :accessor expected (expected :accessor expected
:initform (make-hash-table :test #'equalp)))) :initform (make-hash-table :test #'equalp))))
@ -34,6 +35,9 @@
(funcall (core:make-setup :class 'test-receiver (funcall (core:make-setup :class 'test-receiver
:args (list :suite t:*test-suite*)) cfg)) :args (list :suite t:*test-suite*)) cfg))
(defun collect (ctx msg)
(push msg (collected ctx)))
(defun check-message (ctx msg) (defun check-message (ctx msg)
(let ((key (shape:head msg)) (let ((key (shape:head msg))
(t:*test-suite* (suite ctx))) (t:*test-suite* (suite ctx)))

17
test/test-csys.lisp
View file

@ -35,7 +35,8 @@
(config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4))) (config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
(config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4))) (config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4)))
;(config:add-action '(:csys :effect) #'tc:check-message) ;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))) ;(config:add-action '(:csys) (constantly nil))
(config:add-action '(:csys) #'tc:collect))
(defun proc-env (msg scope) (defun proc-env (msg scope)
(let ((t:*test-suite* (csys:environ scope))) (let ((t:*test-suite* (csys:environ scope)))
@ -50,10 +51,11 @@
(load (t:test-path "config-csys" "etc")) (load (t:test-path "config-csys" "etc"))
(async:init) (async:init)
(unwind-protect (unwind-protect
(test-space) (progn
(test-basic-0) (test-space)
(test-basic-1) (test-basic-0)
(test-basic-2) (test-basic-1)
(test-basic-2))
(sleep 0.02) (sleep 0.02)
(tc:check-expected) (tc:check-expected)
(t:show-result)))) (t:show-result))))
@ -100,11 +102,12 @@
)) ))
(deftest test-basic-0 () (deftest test-basic-0 ()
(let ((environ:*env* (setup (list (basic:prog-b0))))) (let ((environ:*env* (setup (list (basic:prog-b0))))
;(rcvr (tc:receiver t:*test-suite*)) (rcvr (tc:receiver t:*test-suite*)))
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1))) ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
(environ:send-value '(:s00 #(0 1)) 1) (environ:send-value '(:s00 #(0 1)) 1)
(environ:send-value '(:s00 #(0 1)) 2) (environ:send-value '(:s00 #(0 1)) 2)
;(sleep 0.01) (print (tc:collected rcvr))
(teardown))) (teardown)))
(deftest test-basic-1 () (deftest test-basic-1 ()