[cells-cvs] CVS cells/cells-test
ktilton
ktilton at common-lisp.net
Sun Oct 12 01:21:09 UTC 2008
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 #\!))
More information about the Cells-cvs
mailing list