Compare commits
2 commits
0bf199388a
...
e2d82fed8f
| Author | SHA1 | Date | |
|---|---|---|---|
| e2d82fed8f | |||
| 9dfb96d99c |
3 changed files with 22 additions and 35 deletions
|
|
@ -102,9 +102,12 @@
|
||||||
|
|
||||||
;;;; public shortcuts
|
;;;; public shortcuts
|
||||||
|
|
||||||
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*) delay)
|
(defun send-message (head data &key (env *env*))
|
||||||
|
(actor:send env (message:create head :data data)))
|
||||||
|
|
||||||
|
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
|
||||||
(let ((head (cons domain (cons :value cat-loc))))
|
(let ((head (cons domain (cons :value cat-loc))))
|
||||||
(actor:send env (message:create head :data `(:value ,val)))))
|
(send-message head `(:value ,val) :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))
|
||||||
|
|
@ -114,13 +117,8 @@
|
||||||
(when (and (listp target) (< (length target) 3))
|
(when (and (listp target) (< (length target) 3))
|
||||||
(setf target (cons domain target)))
|
(setf target (cons domain target)))
|
||||||
(util:plist-add data :target target)
|
(util:plist-add data :target target)
|
||||||
(util:lgi rcvr target cat-loc head data)
|
(send-message head data :env env)))
|
||||||
(actor:send env (message:create head :data data))))
|
|
||||||
|
|
||||||
(defun x-send-connect (env &rest args &key (domain csys:*domain*) to target op)
|
|
||||||
(let ((head (list domain :connect)))
|
|
||||||
(actor:send env (message:create head :data args))))
|
|
||||||
|
|
||||||
;;;; internal helpers
|
;;;; internal helpers
|
||||||
|
|
||||||
(defun register-cell (reg addr cell)
|
(defun register-cell (reg addr cell)
|
||||||
|
|
|
||||||
|
|
@ -54,12 +54,8 @@
|
||||||
(defun b1-next-one ()
|
(defun b1-next-one ()
|
||||||
(lambda (msg scope)
|
(lambda (msg scope)
|
||||||
(let ((self actor:*self*)
|
(let ((self actor:*self*)
|
||||||
(environ:*env* (csys:environ scope))
|
(environ:*env* (csys:environ scope)))
|
||||||
(env (csys:environ scope)))
|
|
||||||
(environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1))
|
(environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1))
|
||||||
;(environ:send-connect env :to self :target '(:csys :e01 "1-0")
|
|
||||||
; :op (csys:multiply -1))
|
|
||||||
;(environ:send-connect env :to self :target '(:csys :e01 "1-1"))
|
|
||||||
(environ:send-connect self '(:e01 "1-1"))
|
(environ:send-connect self '(:e01 "1-1"))
|
||||||
;; switch :active
|
;; switch :active
|
||||||
nil)))
|
nil)))
|
||||||
|
|
@ -90,14 +86,10 @@
|
||||||
(defun b2-next-one ()
|
(defun b2-next-one ()
|
||||||
(lambda (msg scope)
|
(lambda (msg scope)
|
||||||
(let ((self actor:*self*)
|
(let ((self actor:*self*)
|
||||||
(env (csys:environ scope))
|
(environ:*env* (csys:environ scope)))
|
||||||
(environ:*env* (csys:environ scope))
|
|
||||||
(zero '(:csys :c02 "0-0")))
|
|
||||||
(csys:send-create self :cat :s02 :loc "1-1" :connect :pred)
|
(csys:send-create self :cat :s02 :loc "1-1" :connect :pred)
|
||||||
(csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
|
(csys:send-create self :cat :e02 :loc "2-1" :connect :succ)
|
||||||
(environ:send-connect self '(:c02 "0-0") :op (csys:multiply -1))
|
(environ:send-connect self '(:c02 "0-0") :op (csys:multiply -1))
|
||||||
(environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
|
(environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
|
||||||
;; switch :active
|
;; switch :active
|
||||||
nil)))
|
nil)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -56,7 +56,7 @@
|
||||||
(tc:check-expected)
|
(tc:check-expected)
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(defun setup-test (cfg)
|
(defun setup (cfg &key (delay 0.02))
|
||||||
(setup-config)
|
(setup-config)
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
(destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg
|
(destructuring-bind (prg &key (zero-cat :c00) (zero-val 0) eff-contacts) cfg
|
||||||
|
|
@ -64,36 +64,33 @@
|
||||||
(env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
|
(env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
|
||||||
(setf (tc:receiver t:*test-suite*) rcvr)
|
(setf (tc:receiver t:*test-suite*) rcvr)
|
||||||
(csys:create-zero prg env :categ (list :csys zero-cat) :value zero-val)
|
(csys:create-zero prg env :categ (list :csys zero-cat) :value zero-val)
|
||||||
|
(sleep delay)
|
||||||
env)))
|
env)))
|
||||||
|
|
||||||
|
(defun teardown (&optional (delay 0.03))
|
||||||
|
(sleep delay)
|
||||||
|
(core:shutdown))
|
||||||
|
|
||||||
;;;; test definitions
|
;;;; test definitions
|
||||||
|
|
||||||
(deftest test-basic-0 ()
|
(deftest test-basic-0 ()
|
||||||
(let ((environ:*env* (setup-test (list (basic:prog-b0)))))
|
(let ((environ:*env* (setup (list (basic:prog-b0)))))
|
||||||
;(rcvr (tc:receiver t:*test-suite*))
|
;(rcvr (tc:receiver t:*test-suite*))
|
||||||
(sleep 0.02)
|
|
||||||
;(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.03)
|
(teardown)))
|
||||||
(core:shutdown)))
|
|
||||||
|
|
||||||
(deftest test-basic-1 ()
|
(deftest test-basic-1 ()
|
||||||
(let ((environ:*env* (setup-test (basic:config-b1))))
|
(let ((environ:*env* (setup (basic:config-b1))))
|
||||||
(sleep 0.02)
|
|
||||||
(environ:send-value '(:s01 "0-0") 1)
|
(environ:send-value '(:s01 "0-0") 1)
|
||||||
(environ:send-value '(:s01 "0-1") 2)
|
(environ:send-value '(:s01 "0-1") 2)
|
||||||
(sleep 0.03)
|
(teardown)))
|
||||||
(core:shutdown)))
|
|
||||||
|
|
||||||
(deftest test-basic-2 ()
|
(deftest test-basic-2 ()
|
||||||
(let ((environ:*env* (setup-test (basic:config-b2))))
|
(let ((environ:*env* (setup (basic:config-b2))))
|
||||||
(sleep 0.02)
|
(environ:send-value '(:s02 "1-0") 1) (sleep 0.0001)
|
||||||
(environ:send-value '(:s02 "1-0") 1)
|
(environ:send-value '(:s02 "1-1") 2) (sleep 0.0001) ;; 2 => loop
|
||||||
(sleep 0.0001)
|
|
||||||
(environ:send-value '(:s02 "1-1") 2) ;; 2 => loop
|
|
||||||
(sleep 0.0001)
|
|
||||||
(environ:send-value '(:s02 "1-0") 2) ;; stop loop
|
(environ:send-value '(:s02 "1-0") 2) ;; stop loop
|
||||||
(sleep 0.03)
|
(teardown)))
|
||||||
(core:shutdown)))
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue