csys/environ:send-create for preparing create message

csys/environ.lisp

@@ -11,7 +11,7 @@
   (:export #:*env*
            #:create #:simple-setup #:simple-proc
            #:actions
-           #:send-value #:send-connect))
+           #:send-value #:send-create #:send-connect))
 
 (in-package :scopes/csys/environ)
 
@@ -71,6 +71,7 @@
         :notify (csys:no-op)
         :effect (csys:no-op)
         :value #'forward
+        :create #'forward-create
         :connect #'forward-connect
         :default (csys:no-op :no-forward t)))
 
@@ -97,6 +98,8 @@
           (util:lgw "no addr and no customer in message" msg scope)))))
   nil)
 
+(defun forward-create (msg scope))
+
 (defun forward-connect (msg scope)
   (let* ((head (shape:head msg))
          (data (shape:data msg))
@@ -120,6 +123,13 @@
   (let ((head (cons domain (cons :value cat-loc))))
     (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)
   (let* ((cat-loc (when (listp rcvr) rcvr))
          (head (cons domain (cons :connect cat-loc)))

test/test-core.lisp

@@ -17,7 +17,7 @@
                     (:t :scopes/testing))
   (:export #:run #:user #:password
            #:test-receiver #:receiver #:suite
-           #:expect #:check-message #:check-expected
+           #:collect #:collected #:expect #:check-message #:check-expected
            #:setup #:test-suite)
   (:import-from :scopes/testing #:deftest #:== #:!=))
 
@@ -27,6 +27,7 @@
 
 (defclass test-receiver (core:context)
   ((suite :reader suite :initarg :suite)
+   (collected :accessor collected :initform nil)
    (expected :accessor expected 
              :initform (make-hash-table :test #'equalp))))
 
@@ -34,6 +35,9 @@
   (funcall (core:make-setup :class 'test-receiver
                             :args (list :suite t:*test-suite*)) cfg))
 
+(defun collect (ctx msg)
+  (push msg (collected ctx)))
+
 (defun check-message (ctx msg)
   (let ((key (shape:head msg))
         (t:*test-suite* (suite ctx)))

test/test-csys.lisp

@@ -35,7 +35,8 @@
   (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) #'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)
   (let ((t:*test-suite* (csys:environ scope))) 
@@ -50,10 +51,11 @@
     (load (t:test-path "config-csys" "etc"))
     (async:init)
     (unwind-protect
+      (progn
         (test-space)
         (test-basic-0)
         (test-basic-1)
-      (test-basic-2)
+        (test-basic-2))
       (sleep 0.02)
       (tc:check-expected)
       (t:show-result))))
@@ -100,11 +102,12 @@
     ))
  
 (deftest test-basic-0 ()
-  (let ((environ:*env* (setup (list (basic:prog-b0)))))
-        ;(rcvr (tc:receiver t:*test-suite*))
+  (let ((environ:*env* (setup (list (basic:prog-b0))))
+        (rcvr (tc:receiver t:*test-suite*)))
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
     (environ:send-value '(:s00 #(0 1)) 1)
     (environ:send-value '(:s00 #(0 1)) 2)
+    ;(sleep 0.01) (print (tc:collected rcvr))
     (teardown)))
 
 (deftest test-basic-1 ()