Update of /project/cells/cvsroot/cells/cells-test In directory cl-net:/tmp/cvs-serv22971/cells-test

Modified Files: cells-test.asd cells-test.lpr deep-cells.lisp person.lisp test.lisp Log Message: Just trying to get a patch in for record-caller

--- /project/cells/cvsroot/cells/cells-test/cells-test.asd 2007/12/02 18:47:20 1.1 +++ /project/cells/cvsroot/cells/cells-test/cells-test.asd 2008/10/12 01:21:09 1.2 @@ -9,21 +9,18 @@ :long-description "Informatively-commented regression tests for Cells" :serial t :depends-on (:cells) - :components ((:module "cells-test" - :serial t - :components ((:file "test") - (:file "hello-world") - (:file "test-kid-slotting") - (:file "test-lazy") - (:file "person") - (:file "df-interference") - (:file "test-family") - (:file "output-setf") - (:file "test-cycle") - (:file "test-ephemeral") - (:file "test-synapse") - (:file "deep-cells"))))) + :components ((:file "test") + (:file "hello-world") + (:file "test-kid-slotting") + (:file "test-lazy") + (:file "person") + (:file "df-interference") + (:file "test-family") + (:file "output-setf") + (:file "test-cycle") + (:file "test-ephemeral") + (:file "test-synapse") + (:file "deep-cells"))) +

-(defmethod perform :after ((op load-op) (system (eql (find-system :cells-test)))) - (funcall (find-symbol "TEST-CELLS" "CELLS")))

--- /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2008/04/22 14:50:56 1.10 +++ /project/cells/cvsroot/cells/cells-test/cells-test.lpr 2008/10/12 01:21:09 1.11 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.1 [Windows] (Apr 3, 2008 23:47)"; cg: "1.103.2.10"; -*- +;; -*- lisp-version: "8.1 [Windows] (Oct 11, 2008 17:00)"; cg: "1.103.2.10"; -*-

(in-package :cg-user)

@@ -16,8 +16,11 @@ (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 "deep-cells.lisp")) - :projects (list (make-instance 'project-module :name "..\cells")) + (make-instance 'module :name "deep-cells.lisp") + (make-instance 'module :name "clos-training.lisp") + (make-instance 'module :name "do-req.lisp")) + :projects (list (make-instance 'project-module :name "..\cells" + :show-modules nil)) :libraries nil :distributed-files nil :internally-loaded-files nil @@ -94,6 +97,7 @@ :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard + :build-number 0 :on-initialization 'cells::test-cells :on-restart 'do-default-restart)

--- /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2007/11/30 16:51:19 1.3 +++ /project/cells/cvsroot/cells/cells-test/deep-cells.lisp 2008/10/12 01:21:09 1.4 @@ -4,9 +4,9 @@ (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))) + ((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) --- /project/cells/cvsroot/cells/cells-test/person.lisp 2007/11/30 22:29:06 1.4 +++ /project/cells/cvsroot/cells/cells-test/person.lisp 2008/10/12 01:21:09 1.5 @@ -36,6 +36,16 @@ (incf *name-ct-calc*) (length (names self))))))

+#+test +(progn + (cells-reset) + (inspect + (make-instance 'person + :names '("speedy" "chill") + :pulse (c-in 60) + :speech (c? (car (names self))) + :thought (c? (when (< (pulse self) 100) (speech self)))))) + (defobserver names ((self person) new-names) (format t "~&you can call me ~a" new-names))

@@ -124,6 +134,8 @@ ;; (ct-assert (null (thought p)))))

+ + (def-cell-test cv-test-person-3 () ;; ------------------------------------------------------- ;; dynamic dependency graph maintenance @@ -154,6 +166,7 @@ (setf (pulse p) 50) (ct-assert (eql 1 (length (cd-useds (md-slot-cell p 'thought)))))))

+ (def-cell-test cv-test-person-4 () (let ((p (make-instance 'person :names '("speedy" "chill") @@ -167,8 +180,10 @@ ;; - all cells accessed are constant. ;; (ct-assert (null (md-slot-cell p 'speech))) - (ct-assert (assoc 'speech (cells-flushed p))) - (ct-assert (c-optimized-away-p (cdr (assoc 'speech (cells-flushed p))))) + #-its-alive! + (progn + (ct-assert (assoc 'speech (cells-flushed p))) + (ct-assert (c-optimized-away-p (cdr (assoc 'speech (cells-flushed p))))))

(ct-assert (not (c-optimized-away-p (md-slot-cell p 'thought)))) ;; pulse is variable, so cannot opti (ct-assert (eql 1 (length (cd-useds (md-slot-cell p 'thought))))) ;; but speech is opti, so only 1 used @@ -195,6 +210,8 @@ ;; make sure cyclic dependencies are trapped: ;; (cells-reset) + #+its-alive! t + #-its-alive! (ct-assert (handler-case (progn @@ -205,10 +222,9 @@ (length (names self))))) nil) (t (error) - (describe error) + (describe error) (setf *stop* nil) - t))) - ) + t)))) ;; ;; we'll toss off a quick class to test tolerance of cyclic

--- /project/cells/cvsroot/cells/cells-test/test.lisp 2008/02/16 05:04:55 1.12 +++ /project/cells/cvsroot/cells/cells-test/test.lisp 2008/10/12 01:21:09 1.13 @@ -69,15 +69,21 @@

(defun test-cells () - (loop for test in (reverse *cell-tests*) - when t ; (eq 'cv-test-person-5 test) - do (cell-test-init test) - (funcall test)) - (print (make-string 40 :initial-element #*)) - (print (make-string 40 :initial-element #*)) - (print "*** Cells-test successfully completed **") - (print (make-string 40 :initial-element #*)) - (print (make-string 40 :initial-element #*))) + (dribble "c:/0algebra/cells-test.txt") + (progn ;prof:with-profiling (:type :time) + (time + (progn + (loop for test in (reverse *cell-tests*) + when t ; (eq 'cv-test-person-5 test) + do (cell-test-init test) + (funcall test)) + (print (make-string 40 :initial-element #*)) + (print (make-string 40 :initial-element #*)) + (print "*** Cells-test successfully completed **") + (print (make-string 40 :initial-element #*)) + (print (make-string 40 :initial-element #*))))) + ;(prof:show-call-graph) + (dribble))

(defun cell-test-init (name) (print (make-string 40 :initial-element #!))