[cells-cvs] CVS cells/cells-test
ktilton
ktilton at common-lisp.net
Fri Nov 30 16:51:19 UTC 2007
Update of /project/cells/cvsroot/cells/cells-test
In directory clnet:/tmp/cvs-serv2729/cells-test
Modified Files:
cells-test.lpr deep-cells.lisp test-synapse.lisp test.lisp
Log Message:
--- /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2006/06/10 22:16:35 1.6
+++ /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2007/11/30 16:51:19 1.7
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (May 22, 2006 0:51)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.1 [Windows] (Sep 29, 2007 20:23)"; cg: "1.103.2.10"; -*-
(in-package :cg-user)
@@ -25,64 +25,72 @@
:main-form nil
:compilation-unit t
:verbose nil
- :runtime-modules '(:cg-dde-utils :cg.base :cg.bitmap-pane
- :cg.bitmap-pane.clipboard :cg.bitmap-stream
- :cg.button :cg.caret :cg.check-box :cg.choice-list
- :cg.choose-printer :cg.clipboard
- :cg.clipboard-stack :cg.clipboard.pixmap
- :cg.color-dialog :cg.combo-box :cg.common-control
- :cg.comtab :cg.cursor-pixmap :cg.curve
- :cg.dialog-item :cg.directory-dialog
- :cg.directory-dialog-os :cg.drag-and-drop
- :cg.drag-and-drop-image :cg.drawable
- :cg.drawable.clipboard :cg.dropping-outline
- :cg.edit-in-place :cg.editable-text
- :cg.file-dialog :cg.fill-texture
- :cg.find-string-dialog :cg.font-dialog
- :cg.gesture-emulation :cg.get-pixmap
- :cg.get-position :cg.graphics-context
- :cg.grid-widget :cg.grid-widget.drag-and-drop
- :cg.group-box :cg.header-control :cg.hotspot
- :cg.html-dialog :cg.html-widget :cg.icon
- :cg.icon-pixmap :cg.ie :cg.item-list
- :cg.keyboard-shortcuts :cg.lamp :cg.lettered-menu
- :cg.lisp-edit-pane :cg.lisp-text :cg.lisp-widget
- :cg.list-view :cg.mci :cg.menu :cg.menu.tooltip
- :cg.message-dialog :cg.multi-line-editable-text
- :cg.multi-line-lisp-text :cg.multi-picture-button
- :cg.multi-picture-button.drag-and-drop
- :cg.multi-picture-button.tooltip :cg.ocx
- :cg.os-widget :cg.os-window :cg.outline
- :cg.outline.drag-and-drop
- :cg.outline.edit-in-place :cg.palette
- :cg.paren-matching :cg.picture-widget
- :cg.picture-widget.palette :cg.pixmap
- :cg.pixmap-widget :cg.pixmap.file-io
- :cg.pixmap.printing :cg.pixmap.rotate :cg.printing
- :cg.progress-indicator :cg.project-window
- :cg.property :cg.radio-button :cg.rich-edit
- :cg.rich-edit-pane :cg.rich-edit-pane.clipboard
- :cg.rich-edit-pane.printing :cg.sample-file-menu
- :cg.scaling-stream :cg.scroll-bar
- :cg.scroll-bar-mixin :cg.selected-object
- :cg.shortcut-menu :cg.static-text :cg.status-bar
- :cg.string-dialog :cg.tab-control
- :cg.template-string :cg.text-edit-pane
- :cg.text-edit-pane.file-io :cg.text-edit-pane.mark
- :cg.text-or-combo :cg.text-widget :cg.timer
- :cg.toggling-widget :cg.toolbar :cg.tooltip
- :cg.trackbar :cg.tray :cg.up-down-control
- :cg.utility-dialog :cg.web-browser
- :cg.web-browser.dde :cg.wrap-string
- :cg.yes-no-list :cg.yes-no-string :dde)
+ :runtime-modules (list :cg-dde-utils :cg.base :cg.bitmap-pane
+ :cg.bitmap-pane.clipboard :cg.bitmap-stream
+ :cg.button :cg.caret :cg.check-box
+ :cg.choice-list :cg.choose-printer
+ :cg.clipboard :cg.clipboard-stack
+ :cg.clipboard.pixmap :cg.color-dialog
+ :cg.combo-box :cg.common-control :cg.comtab
+ :cg.cursor-pixmap :cg.curve :cg.dialog-item
+ :cg.directory-dialog :cg.directory-dialog-os
+ :cg.drag-and-drop :cg.drag-and-drop-image
+ :cg.drawable :cg.drawable.clipboard
+ :cg.dropping-outline :cg.edit-in-place
+ :cg.editable-text :cg.file-dialog
+ :cg.fill-texture :cg.find-string-dialog
+ :cg.font-dialog :cg.gesture-emulation
+ :cg.get-pixmap :cg.get-position
+ :cg.graphics-context :cg.grid-widget
+ :cg.grid-widget.drag-and-drop :cg.group-box
+ :cg.header-control :cg.hotspot :cg.html-dialog
+ :cg.html-widget :cg.icon :cg.icon-pixmap
+ :cg.ie :cg.item-list :cg.keyboard-shortcuts
+ :cg.lamp :cg.lettered-menu :cg.lisp-edit-pane
+ :cg.lisp-text :cg.lisp-widget :cg.list-view
+ :cg.mci :cg.menu :cg.menu.tooltip
+ :cg.message-dialog
+ :cg.multi-line-editable-text
+ :cg.multi-line-lisp-text
+ :cg.multi-picture-button
+ :cg.multi-picture-button.drag-and-drop
+ :cg.multi-picture-button.tooltip :cg.ocx
+ :cg.os-widget :cg.os-window :cg.outline
+ :cg.outline.drag-and-drop
+ :cg.outline.edit-in-place :cg.palette
+ :cg.paren-matching :cg.picture-widget
+ :cg.picture-widget.palette :cg.pixmap
+ :cg.pixmap-widget :cg.pixmap.file-io
+ :cg.pixmap.printing :cg.pixmap.rotate
+ :cg.printing :cg.progress-indicator
+ :cg.project-window :cg.property
+ :cg.radio-button :cg.rich-edit
+ :cg.rich-edit-pane
+ :cg.rich-edit-pane.clipboard
+ :cg.rich-edit-pane.printing
+ :cg.sample-file-menu :cg.scaling-stream
+ :cg.scroll-bar :cg.scroll-bar-mixin
+ :cg.selected-object :cg.shortcut-menu
+ :cg.static-text :cg.status-bar
+ :cg.string-dialog :cg.tab-control
+ :cg.template-string :cg.text-edit-pane
+ :cg.text-edit-pane.file-io
+ :cg.text-edit-pane.mark :cg.text-or-combo
+ :cg.text-widget :cg.timer :cg.toggling-widget
+ :cg.toolbar :cg.tooltip :cg.trackbar :cg.tray
+ :cg.up-down-control :cg.utility-dialog
+ :cg.web-browser :cg.web-browser.dde
+ :cg.wrap-string :cg.yes-no-list
+ :cg.yes-no-string :dde)
:splash-file-module (make-instance 'build-module :name "")
:icon-file-module (make-instance 'build-module :name "")
- :include-flags '(:top-level :debugger)
- :build-flags '(:allow-runtime-debug :purify)
+ :include-flags (list :top-level :debugger)
+ :build-flags (list :allow-runtime-debug :purify)
:autoload-warning t
:full-recompile-for-runtime-conditionalizations nil
+ :include-manifest-file-for-visual-styles t
:default-command-line-arguments "+M +t \"Console for Debugging\""
- :additional-build-lisp-image-arguments '(:read-init-files nil)
+ :additional-build-lisp-image-arguments (list :read-init-files nil)
:old-space-size 256000
:new-space-size 6144
:runtime-build-option :standard
--- /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2006/03/22 04:08:35 1.2
+++ /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2007/11/30 16:51:19 1.3
@@ -34,12 +34,12 @@
(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
+ (loop for (defer-info . 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)))
+ (funcall task :user-q defer-info)))
(def-cell-test go-deep ()
(cells-reset 'deep-queue-handler)
--- /project/cells/cvsroot/cells/cells-test/test-synapse.lisp 2006/06/23 01:04:56 1.2
+++ /project/cells/cvsroot/cells/cells-test/test-synapse.lisp 2007/11/30 16:51:19 1.3
@@ -33,6 +33,29 @@
(defobserver m-syn-b ()
(print `(output m-syn-b ,self ,new-value ,old-value)))
+(def-cell-test m-syn-bool
+ (let* ((delta-ct 0)
+ (m (make-instance 'm-syn
+ :m-syn-a (c-in nil)
+ :m-syn-b (c? (incf delta-ct)
+ (trc "syn-b containing rule firing!!!!!!!!!!!!!!" delta-ct)
+ (bwhen (msg (with-synapse :xyz42 ()
+ (trc "synapse fires!!! ~a" (^m-syn-a))
+ (bIF (k (find (^m-syn-a) '(:one :two :three)))
+ (values k :propagate)
+ (values NIL :no-propagate))))
+ msg)))))
+ (ct-assert (= 1 delta-ct))
+ (ct-assert (null (m-syn-b m)))
+ (setf (m-syn-a m) :nine)
+ (ct-assert (= 1 delta-ct))
+ (ct-assert (null (m-syn-b m)))
+ (setf (m-syn-a m) :one)
+ (ct-assert (= 2 delta-ct))
+ (ct-assert (eq :one (m-syn-b m)))
+ (setf (m-syn-a m) :nine)
+ (ct-assert (= 2 delta-ct))
+ (ct-assert (eq :one (m-syn-b m)))))
(def-cell-test m-syn
(let* ((delta-ct 0)
--- /project/cells/cvsroot/cells/cells-test/test.lisp 2006/11/04 20:52:01 1.9
+++ /project/cells/cvsroot/cells/cells-test/test.lisp 2007/11/30 16:51:19 1.10
@@ -68,8 +68,10 @@
#+go
(test-cells)
+
(defun test-cells ()
(loop for test in (reverse *cell-tests*)
+ when (eq 'm-syn-bool test)
do (cell-test-init test)
(funcall test))
(print (make-string 40 :initial-element #\*))
More information about the Cells-cvs
mailing list