Update of /project/cells/cvsroot/cells/cells-test In directory clnet:/tmp/cvs-serv31950/Cells-test
Modified Files: cells-test.lpr Added Files: deep-cells.lisp Log Message: New deep-cells.lisp to demo Cells 3
--- /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2006/03/16 05:22:08 1.3 +++ /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2006/03/18 00:14:01 1.4 @@ -15,7 +15,8 @@ (make-instance 'module :name "output-setf.lisp") (make-instance 'module :name "test-cycle.lisp") (make-instance 'module :name "test-ephemeral.lisp") - (make-instance 'module :name "test-synapse.lisp")) + (make-instance 'module :name "test-synapse.lisp") + (make-instance 'module :name "deep-cells.lisp")) :projects (list (make-instance 'project-module :name "..\cells")) :libraries nil :distributed-files nil
--- /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2006/03/18 00:14:01 NONE +++ /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2006/03/18 00:14:01 1.1 (defvar *client-log*) (defvar *obs-1-count*)
(defmodel deep () ((cell-2 :cell :ephemeral :initform (c-in 'two) :accessor :cell-2) (cell-1 :initform (c? (list 'one (^cell-2) (^cell-3))) :accessor :cell-1) (cell-3 :initform (c-in 'c3-unset) :accessor :cell-3)))
(defobserver cell-1 () (trc "cell-1 observer raw now enqueing client to run first. (new,old)=" new-value old-value) (with-integrity (:client 1) (trc "cell-1 :client now running" new-value (incf *obs-1-count*)) (eko ("c1-obs->*client-log*: ") (setf *client-log* (list new-value)))))
(defobserver cell-2 () (trc "cell-2 observer raw now enqueing change and client to run second. (new,old)=" new-value old-value) (with-integrity (:change) (trc "cell-2 observer :change now running" *client-log*) (ct-assert (equal *client-log* '((one two c3-unset) two c3-unset))) (setf (^cell-3) (case new-value (two 'three) (otherwise 'trouble)))) (with-integrity (:client 2) (trc "client cell-2 :client running") (eko ("c2-obs->*client-log*: ") (setf *client-log* (append *client-log* (list new-value))))))
(defobserver cell-3 () (trc "cell-3 observer raw now enqueing client to run third. (new,old)=" new-value old-value) (with-integrity (:client 3) (trc "cell-3 observer :client now running" new-value) (eko ("c3-obs->*client-log*: ") (setf *client-log* (append *client-log* (list new-value))))))
(defun deep-queue-handler (client-q) (loop for (nil . task) in (prog1 (sort (fifo-data client-q) '< :key 'car) (fifo-clear client-q)) do (trc nil "!!! --- deep-queue-handler dispatching" defer-info) (funcall task)))
(def-cell-test go-deep () (cells-reset 'deep-queue-handler) (setf *obs-1-count* 0) (make-instance 'deep) (ct-assert (eql 2 *obs-1-count*)) ;; because the cell-2 observer does a setf on something used by c1 (trc "testing *client-log*" *client-log*) (ct-assert (tree-equal *client-log* '((one nil three) three))))