;;;; 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 () (util:plist-merge (list :next (next-zero-initial)) (csys:basic-actions))) (defun next-zero-initial () (lambda (msg scope) (let ((self actor:*self*)) (csys:send-create self :cat :e01 :connect :succ) (csys:send-create self :cat :s01 :name "0-1" :connect :pred) (csys:send-connect self self :op (csys: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))) (environ:send-value env 1 :cat :s01 :name "0-1") (environ:send-value env 2 :cat :s01 :name "0-1") (sleep 0.1) (core:shutdown)))