From 0335e7e54d2db51586432ebc27fa30d6a5d7e95d Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Mon, 9 Mar 2026 07:51:02 +0100 Subject: [PATCH] csys tests: use test-core receiver; + test-core fixes --- csys/csys.lisp | 12 +++++------- scopes-csys.asd | 2 +- test/test-core.lisp | 15 ++++++++++----- test/test-csys.lisp | 40 +++++++++++++++++++++++----------------- 4 files changed, 39 insertions(+), 30 deletions(-) diff --git a/csys/csys.lisp b/csys/csys.lisp index 4effd75..7d92e8d 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -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)) + diff --git a/scopes-csys.asd b/scopes-csys.asd index b9978f4..d546c70 100644 --- a/scopes-csys.asd +++ b/scopes-csys.asd @@ -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))) diff --git a/test/test-core.lisp b/test/test-core.lisp index 7f564cc..367349f 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -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))))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 8632b0a..409b7a6 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -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) )