Update of /project/cells/cvsroot/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv6383/cells-test
Modified Files: cells-test.lpr internal-combustion.lisp synapse-testing.lisp test.lisp Log Message: resurrect cells-test; restore c-optimize somehow disabled at some point Date: Fri Aug 26 16:27:59 2005 Author: ktilton
Index: cells/cells-test/cells-test.lpr diff -u cells/cells-test/cells-test.lpr:1.1 cells/cells-test/cells-test.lpr:1.2 --- cells/cells-test/cells-test.lpr:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/cells-test.lpr Fri Aug 26 16:27:59 2005 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "7.0 [Windows] (Apr 6, 2005 17:03)"; cg: "1.54.2.17"; -*- +;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*-
(in-package :cg-user)
Index: cells/cells-test/internal-combustion.lisp diff -u cells/cells-test/internal-combustion.lisp:1.1 cells/cells-test/internal-combustion.lisp:1.2 --- cells/cells-test/internal-combustion.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/internal-combustion.lisp Fri Aug 26 16:27:59 2005 @@ -225,14 +225,16 @@ (cell-reset) t))) ;; something non-nil to satisfy assert
- (cv-assert - (handler-case - (let ((e (make-be 'engine :cylinders (c? (+ 2 2))))) - (setf (cylinders e) 6) - nil) ;; bad to reach here - (t (error) (trc "error correctly is" error) - (setf *stop* nil) - t))) + (let ((e (make-be 'engine :cylinders (c? (+ 2 2))))) + (assert *c-debug*) + (cv-assert + (handler-case + (progn + (setf (cylinders e) 6) + nil) ;; bad to reach here + (t (error) (trc "error correctly is" error) + (setf *stop* nil) + t)))) (when *stop* (break "stopped! 1")) (cv-test-propagation-on-slot-write) (cv-test-no-prop-unchanged)
Index: cells/cells-test/synapse-testing.lisp diff -u cells/cells-test/synapse-testing.lisp:1.1 cells/cells-test/synapse-testing.lisp:1.2 --- cells/cells-test/synapse-testing.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/synapse-testing.lisp Fri Aug 26 16:27:59 2005 @@ -33,7 +33,7 @@ (let ((self (make-be 'counter-10 :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) - (f-sensitivity (10) + (f-sensitivity :dummy-id (10) (^ct)))))) (cv-assert (zerop (^ct10))) (loop for n below 30 @@ -48,7 +48,7 @@ :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) (trc "runnning ct10-rule 1") - (f-delta () + (f-delta :dummy () (^ct)))))) (cv-assert (zerop (^ct10))) (cv-assert (zerop (^ct))) @@ -62,7 +62,7 @@ (let ((self (make-be 'counter-10 :ct (c-in 0) :ct10 (c? (count-it :ct10-rule) - (f-delta (:sensitivity 4) + (f-delta :xxx (:sensitivity 4) (^ct)))))) (cv-assert (null (^ct10))) (cv-assert (zerop (^ct)))
Index: cells/cells-test/test.lisp diff -u cells/cells-test/test.lisp:1.1 cells/cells-test/test.lisp:1.2 --- cells/cells-test/test.lisp:1.1 Fri May 6 23:05:51 2005 +++ cells/cells-test/test.lisp Fri Aug 26 16:27:59 2005 @@ -52,26 +52,26 @@ (length *failed-tests*) ',(length tests) *failed-tests*))))
(defun cv-test () - (let ((*c-debug* t)) - (with-testing - (cell-reset) - (test-cells) + (with-testing (cell-reset) - (hello-world) ;; non-assertive + (let ((*c-debug* t)) + (test-cells) + (cell-reset) + (hello-world) ;; non-assertive
- (cv-test-engine) - (cv-test-person) - (df-test) - (cv-test-family) - (cv-family-values) - (cv-kid-slotting) - (boiler-1) - (boiler-2) - (boiler-3) ;; non-assertive - (boiler-4) ;; non-assertive - (cv-laziness) - (cv-output-setf) - (cv-test-lazy)))) + (cv-test-engine) + (cv-test-person) + (df-test) + (cv-test-family) + (cv-family-values) + (cv-kid-slotting) + (boiler-1) + (boiler-2) + (boiler-3) ;; non-assertive + (boiler-4) ;; non-assertive + (cv-laziness) + (cv-output-setf) + (cv-test-lazy))))
#+test