Compare commits
No commits in common. "e923218cd6d23125900578f38efac5c9f362323c" and "534404d9770359513cafba6c9b7d361df381f8d9" have entirely different histories.
e923218cd6
...
534404d977
3 changed files with 9 additions and 26 deletions
|
|
@ -11,7 +11,7 @@
|
||||||
(:export #:*env*
|
(:export #:*env*
|
||||||
#:create #:simple-setup #:simple-proc
|
#:create #:simple-setup #:simple-proc
|
||||||
#:actions
|
#:actions
|
||||||
#:send-value #:send-create #:send-connect))
|
#:send-value #:send-connect))
|
||||||
|
|
||||||
(in-package :scopes/csys/environ)
|
(in-package :scopes/csys/environ)
|
||||||
|
|
||||||
|
|
@ -71,7 +71,6 @@
|
||||||
:notify (csys:no-op)
|
:notify (csys:no-op)
|
||||||
:effect (csys:no-op)
|
:effect (csys:no-op)
|
||||||
:value #'forward
|
:value #'forward
|
||||||
:create #'forward-create
|
|
||||||
:connect #'forward-connect
|
:connect #'forward-connect
|
||||||
:default (csys:no-op :no-forward t)))
|
:default (csys:no-op :no-forward t)))
|
||||||
|
|
||||||
|
|
@ -98,8 +97,6 @@
|
||||||
(util:lgw "no addr and no customer in message" msg scope)))))
|
(util:lgw "no addr and no customer in message" msg scope)))))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(defun forward-create (msg scope))
|
|
||||||
|
|
||||||
(defun forward-connect (msg scope)
|
(defun forward-connect (msg scope)
|
||||||
(let* ((head (shape:head msg))
|
(let* ((head (shape:head msg))
|
||||||
(data (shape:data msg))
|
(data (shape:data msg))
|
||||||
|
|
@ -123,13 +120,6 @@
|
||||||
(let ((head (cons domain (cons :value cat-loc))))
|
(let ((head (cons domain (cons :value cat-loc))))
|
||||||
(send-message head `(:value ,val) :env env)))
|
(send-message head `(:value ,val) :env env)))
|
||||||
|
|
||||||
(defun send-create (rcvr &key (domain "csys:*domain*") (env *env*) connect op)
|
|
||||||
(let ((head (cons domain :create))
|
|
||||||
data)
|
|
||||||
(when connect (util:plist-add data :connect connect))
|
|
||||||
(when op (util:plist-add data :op op))
|
|
||||||
(send-message head data :customer rcvr :env env)))
|
|
||||||
|
|
||||||
(defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
|
(defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
|
||||||
(let* ((cat-loc (when (listp rcvr) rcvr))
|
(let* ((cat-loc (when (listp rcvr) rcvr))
|
||||||
(head (cons domain (cons :connect cat-loc)))
|
(head (cons domain (cons :connect cat-loc)))
|
||||||
|
|
|
||||||
|
|
@ -17,7 +17,7 @@
|
||||||
(:t :scopes/testing))
|
(:t :scopes/testing))
|
||||||
(:export #:run #:user #:password
|
(:export #:run #:user #:password
|
||||||
#:test-receiver #:receiver #:suite
|
#:test-receiver #:receiver #:suite
|
||||||
#:collect #:collected #:expect #:check-message #:check-expected
|
#:expect #:check-message #:check-expected
|
||||||
#:setup #:test-suite)
|
#:setup #:test-suite)
|
||||||
(:import-from :scopes/testing #:deftest #:== #:!=))
|
(:import-from :scopes/testing #:deftest #:== #:!=))
|
||||||
|
|
||||||
|
|
@ -27,7 +27,6 @@
|
||||||
|
|
||||||
(defclass test-receiver (core:context)
|
(defclass test-receiver (core:context)
|
||||||
((suite :reader suite :initarg :suite)
|
((suite :reader suite :initarg :suite)
|
||||||
(collected :accessor collected :initform nil)
|
|
||||||
(expected :accessor expected
|
(expected :accessor expected
|
||||||
:initform (make-hash-table :test #'equalp))))
|
:initform (make-hash-table :test #'equalp))))
|
||||||
|
|
||||||
|
|
@ -35,9 +34,6 @@
|
||||||
(funcall (core:make-setup :class 'test-receiver
|
(funcall (core:make-setup :class 'test-receiver
|
||||||
:args (list :suite t:*test-suite*)) cfg))
|
:args (list :suite t:*test-suite*)) cfg))
|
||||||
|
|
||||||
(defun collect (ctx msg)
|
|
||||||
(push msg (collected ctx)))
|
|
||||||
|
|
||||||
(defun check-message (ctx msg)
|
(defun check-message (ctx msg)
|
||||||
(let ((key (shape:head msg))
|
(let ((key (shape:head msg))
|
||||||
(t:*test-suite* (suite ctx)))
|
(t:*test-suite* (suite ctx)))
|
||||||
|
|
|
||||||
|
|
@ -35,8 +35,7 @@
|
||||||
(config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
|
(config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
|
||||||
(config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4)))
|
(config:add-action '(:csys :effect :e02) (value-in '(1 2 3 4)))
|
||||||
;(config:add-action '(:csys :effect) #'tc:check-message)
|
;(config:add-action '(:csys :effect) #'tc:check-message)
|
||||||
;(config:add-action '(:csys) (constantly nil))
|
(config:add-action '(:csys) (constantly nil)))
|
||||||
(config:add-action '(:csys) #'tc:collect))
|
|
||||||
|
|
||||||
(defun proc-env (msg scope)
|
(defun proc-env (msg scope)
|
||||||
(let ((t:*test-suite* (csys:environ scope)))
|
(let ((t:*test-suite* (csys:environ scope)))
|
||||||
|
|
@ -51,11 +50,10 @@
|
||||||
(load (t:test-path "config-csys" "etc"))
|
(load (t:test-path "config-csys" "etc"))
|
||||||
(async:init)
|
(async:init)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(test-space)
|
||||||
(test-space)
|
(test-basic-0)
|
||||||
(test-basic-0)
|
(test-basic-1)
|
||||||
(test-basic-1)
|
(test-basic-2)
|
||||||
(test-basic-2))
|
|
||||||
(sleep 0.02)
|
(sleep 0.02)
|
||||||
(tc:check-expected)
|
(tc:check-expected)
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
@ -102,12 +100,11 @@
|
||||||
))
|
))
|
||||||
|
|
||||||
(deftest test-basic-0 ()
|
(deftest test-basic-0 ()
|
||||||
(let ((environ:*env* (setup (list (basic:prog-b0))))
|
(let ((environ:*env* (setup (list (basic:prog-b0)))))
|
||||||
(rcvr (tc:receiver t:*test-suite*)))
|
;(rcvr (tc:receiver t:*test-suite*))
|
||||||
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
||||||
(environ:send-value '(:s00 #(0 1)) 1)
|
(environ:send-value '(:s00 #(0 1)) 1)
|
||||||
(environ:send-value '(:s00 #(0 1)) 2)
|
(environ:send-value '(:s00 #(0 1)) 2)
|
||||||
;(sleep 0.01) (print (tc:collected rcvr))
|
|
||||||
(teardown)))
|
(teardown)))
|
||||||
|
|
||||||
(deftest test-basic-1 ()
|
(deftest test-basic-1 ()
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue