csys tests: use test-core receiver; + test-core fixes

This commit is contained in:
Helmut Merz 2026-03-09 07:51:02 +01:00
parent 3782305853
commit 0335e7e54d
4 changed files with 39 additions and 30 deletions

View file

@ -15,7 +15,7 @@
#:send #:send-message
#:neuron #:synapse
#:make-neuron #:update-neuron
#:make-eff-proc #:handle-action))
#:handle-action))
(in-package :scopes/csys)
@ -87,12 +87,6 @@
(forward nmsg nsyns)
(update-neuron #'std-proc nst nsyns env)))
(defun make-eff-proc (handler)
(lambda (msg state syns env)
;(util:lgi msg)
(funcall handler msg)
(handle-action msg state syns env :default #'remember)))
(defun forward (msg syns)
(dolist (s syns)
(funcall s msg)))
@ -115,3 +109,7 @@
(sensor (make-neuron actor:*self* :state key)))
(setf (gethash key (sensors env)) (list sensor))
(list msg state syns)))
(defun add (msg state syns env)
(list msg (+ (shape:data msg) state) syns env))

View file

@ -14,7 +14,7 @@
:in-order-to ((test-op (test-op "scopes-csys/test"))))
(defsystem :scopes-csys/test
:depends-on (:scopes-csys)
:depends-on (:scopes-csys :scopes-core/test)
:components ((:file "test/test-csys"))
:perform (test-op (o c)
(symbol-call :scopes/test-csys :run)))

View file

@ -14,7 +14,9 @@
(:shape :scopes/shape)
(:util :scopes/util)
(:t :scopes/testing))
(:export #:run #:user #:password)
(:export #:run #:user #:password
#:test-receiver #:receiver #:expect #:check-message #:check-expected
#:setup #:test-suite)
(:import-from :scopes/testing #:deftest #:== #:!=))
(in-package :scopes/test-core)
@ -22,18 +24,21 @@
;;;; core/testing: test-receiver
(defclass test-receiver (core:context)
((expected :accessor expected
((suite :reader suite :initarg :suite)
(expected :accessor expected
:initform (make-hash-table :test #'equalp))))
(defun setup (cfg)
(funcall (core:make-setup :class 'test-receiver) cfg))
(funcall (core:make-setup :class 'test-receiver
:args (list :suite t:*test-suite*)) cfg))
(defun check-message (ctx msg)
(let ((key (shape:head msg)))
(let ((key (shape:head msg))
(t:*test-suite* (suite ctx)))
(multiple-value-bind (val found) (gethash key (expected ctx))
(if found
(progn
(if (not (equalp (shape:data msg) val))
(if (and val (not (equalp (shape:data msg) val)))
(t:failure "data mismatch: ~s, expected: ~s" msg val))
(remhash key (expected ctx)))
(t:failure "unexpected: ~s" msg)))))

View file

@ -12,7 +12,8 @@
(:message :scopes/core/message)
(:shape :scopes/shape)
(:util :scopes/util)
(:t :scopes/testing))
(:t :scopes/testing)
(:tc :scopes/test-core))
(:export #:run)
(:import-from :scopes/testing #:deftest #:== #:!= #:in-seq))
@ -23,41 +24,46 @@
(defclass test-env (csys:environment)
((test-suite :reader test-suite :initarg :test-suite)))
(defun eff-handler (state &optional (env csys:*environment*))
(lambda (msg)
(util:lgi msg state)
(let ((t:*test-suite* (test-suite env))
(val (shape:data msg)))
(unless (consp val)
(setf state (in-seq val state :remove t))))))
(defun setup-config ()
(config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :sub) #'tc:check-message)
(config:add-action '(:csys) (constantly nil))
)
(defun add (msg state syns env)
(list msg (+ (shape:data msg) state) syns env))
(defun eff-proc (msg state syns env)
(util:lgi msg)
(let ((t:*test-suite* (test-suite env)))
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) msg))
(csys:handle-action msg state syns env))
;;;; test runner
(defun run ()
(async:init)
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
(let* ((t:*test-suite* (make-instance 'tc:test-suite :name "csys"))
(csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)))
(load (t:test-path "config-csys" "etc"))
(setup-config)
(core:setup-services)
(unwind-protect
(progn
(test-init))
(let ((rcvr (core:find-service :test-receiver)))
(setf (tc:receiver t:*test-suite*) rcvr)
(test-init rcvr))
(sleep 0.1)
(async:finish)
(core:shutdown)
(tc:check-expected)
(t:show-result))))
(deftest test-init ()
(setf (gethash '(:effect :default) (csys:procs csys:*environment*))
(csys:make-eff-proc (eff-handler '(1 3 4 5))))
(deftest test-init (rcvr)
(setf (gethash '(:effect :default) (csys:procs csys:*environment*)) #'eff-proc)
;(csys:make-eff-proc (eff-handler '(1 3 4 5))))
(csys:init)
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
(sleep 0.1)
(csys:send-message '(:csys :add :std :s1) 1)
(csys:send-message '(:csys :add :std :s1) 3)
(tc:expect rcvr (message:create '(:csys :sub :std :s2) :data 4))
(csys:send-message '(:csys :sub :std :s2) 4)
(csys:send-message '(:csys :add :std :s2) 5)
)