cl-scopes/test/test-csys.lisp

80 lines
2.6 KiB
Common Lisp

;;;; cl-scopes/test-csys - testing for the scopes-csys system.
(defpackage :scopes/test-csys
(:use :common-lisp)
(:local-nicknames (:alx :alexandria)
(:actor :scopes/core/actor)
(:async :scopes/util/async)
(:config :scopes/config)
(:core :scopes/core)
(:csys :scopes/csys)
(:environ :scopes/csys/environ)
(:logging :scopes/logging)
(:message :scopes/core/message)
(:shape :scopes/shape)
(:util :scopes/util)
(:t :scopes/testing)
(:tc :scopes/test-core))
(:export #:run)
(:import-from :scopes/testing #:deftest #:== #:!= #:in-seq))
(in-package :scopes/test-csys)
;;;; testing environment
(defun check-seq (seq)
(lambda (ctx msg)
(let ((t:*test-suite* (tc:suite ctx)))
(t:in-seq (shape:data msg) seq))))
(defun setup-config ()
(config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :sub) (check-seq '(4)))
(config:add-action '(:csys :add) (check-seq '(1 3 5)))
(config:add-action '(:csys) (constantly nil))
)
(defun proc-env (msg scope)
(let ((t:*test-suite* (csys:environ scope)))
(destructuring-bind (nmsg scope) (csys:handle-action msg scope)
(util:lgi nmsg)
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
(defun run ()
(let ((t:*test-suite* (make-instance 'tc:test-suite :name "csys")))
(load (t:test-path "config-csys" "etc"))
(async:init)
(unwind-protect
(test-basic-0)
(sleep 0.1)
(t:show-result))))
;;;; test: initialization
(defun setup-test-basic-0 ()
(setup-config)
(core:setup-services)
(setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver))
;(csys:add-action '(:csys :sensor) #'csys:create-sensor)
(let* ((prog (csys:make-prog #'proc-env))
(env (csys:neuron (csys:scope prog
:environ (tc:receiver t:*test-suite*)))))
;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env)
))
(deftest test-basic-0 ()
(setup-test-basic-0)
(sleep 0.1)
(core:shutdown)
)
(deftest x-test-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)
;(csys:send-message '(:csys :sub :std :s2) 4)
;(csys:send-message '(:csys :add :std :s2) 5)
(core:shutdown)
)