102 lines
3.4 KiB
Common Lisp
102 lines
3.4 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 value-in (seq)
|
|
(lambda (ctx msg)
|
|
(let ((t:*test-suite* (tc:suite ctx)))
|
|
(t:in-seq (getf (shape:data msg) :value) seq))))
|
|
|
|
(defun setup-config ()
|
|
(config:add :test-receiver :setup #'tc:setup)
|
|
(config:add-action '(:csys :effect :e01) (value-in '(1 2)))
|
|
;(config:add-action '(:csys :effect) #'tc:check-message)
|
|
(config:add-action '(:csys) (constantly nil)))
|
|
|
|
(defun proc-env (msg scope)
|
|
(let ((t:*test-suite* (csys:environ scope)))
|
|
(util:mv-bind (nmsg (scope scope))
|
|
(csys:handle-action msg scope :actions (environ:actions))
|
|
(util:lgi msg nmsg)
|
|
(when 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)
|
|
(tc:check-expected)
|
|
(t:show-result))))
|
|
|
|
(defun setup-test (prg)
|
|
(setup-config)
|
|
(core:setup-services)
|
|
(let* ((recv (core:find-service :test-receiver))
|
|
(env (environ:create #'proc-env t:*test-suite*)))
|
|
(setf (tc:receiver t:*test-suite*) recv)
|
|
(csys:create-zero prg env)
|
|
env))
|
|
|
|
;;;; test-specific programs / actions
|
|
;;;; (move to scopes/csys/programs)
|
|
|
|
(defun prog-b0 ()
|
|
(csys:make-program
|
|
(list '(:c00 :initial) (csys:std-proc :actions (actions-zero-initial))
|
|
'(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions))
|
|
':default (csys:std-proc :actions (csys:basic-actions)))))
|
|
|
|
(defun actions-zero-initial ()
|
|
(let ((acts (csys:basic-actions)))
|
|
(setf (getf acts :next) (next-zero-initial))
|
|
acts))
|
|
|
|
(defun next-zero-initial ()
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*)
|
|
(cr '(:csys :create :c00 "0-0"))
|
|
(conn '(:csys :connect :c00 "0-0")))
|
|
(actor:send self
|
|
(message:create cr :data '(:categ (:csys :e01) :connect :succ)))
|
|
(actor:send self
|
|
(message:create cr :data '(:addr (:csys :s01 "0-1") :connect :pred)))
|
|
(actor:send self
|
|
(message:create conn :data (list :target self :op (csys:multiply -1))))
|
|
;; connect *self* :op (multiply -1)
|
|
;; switch :active
|
|
nil)))
|
|
|
|
;;;; test definitions
|
|
|
|
(deftest test-basic-0 ()
|
|
(let ((env (setup-test (prog-b0)))
|
|
(rcvr (tc:receiver t:*test-suite*)))
|
|
(sleep 0.1)
|
|
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
|
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 1)))
|
|
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 2)))
|
|
(sleep 0.1)
|
|
(core:shutdown)))
|