work in progress: testing improvements

forge/forge.lisp

@@ -155,11 +155,9 @@
     rv))
 
 (defun seq-add (seq v)
-  (let (rv)
     (funcall seq #'(lambda (start cur end)
                      (setf (cdr end) (list v))
                      (pop end)
-                     (setf rv v)
                      (list start cur end)))
-    rv))
+    nil)
 

scratch.lisp

@@ -3,6 +3,8 @@
 (asdf:load-system :scopes)
 
 (in-package :cl-user)
+#+ecl
+(use-package :ext)
 
 ;;; real scratch area
 
@@ -14,6 +16,7 @@
 (defun iter-current (it)
   (funcall it #'(lambda (p) (car (svref p 0)))))
 
+#+ecl
 (defun classes ()
   (let ((r nil)) 
     (maphash #'(lambda (k v) 

test/test-forge.lisp

@@ -12,7 +12,7 @@
 (in-package :scopes/test-forge)
 
 (defun run ()
-  (let ((t:*tst* (t:test-suite)))
+  (let ((t:*test-suite* (t:test-suite)))
     (test-seq)
     (test-exec)
     ;(format t "~%data-stack ~a" (dstack))

test/test-storage.lisp

@@ -21,18 +21,19 @@
 
 (defun run-sqlite ()
   (load "test/config-sqlite")
-  (let ((storage:*db-config* *db-config-test*))
+  (let ((storage:*db-config* *db-config-test*)
+        (t:*test-suite* (t:test-suite "test-sqlite")))
     (run)))
 
 (defun run-postgres ()
   (load "test/config-postgres")
-  (let ((storage:*db-config* *db-config-test*))
+  (let ((storage:*db-config* *db-config-test*)
+        (t:*test-suite* (t:test-suite)))
     (run)))
 
 (defun run ()
   (let* ((engine (storage:make-engine))
-         (st (storage:make-storage engine))
+         (st (storage:make-storage engine)))
-         (t:*tst* (t:test-suite)))
     (setf (storage:schema st) (getf (storage:db-options st) :schema))
     (test-track st)
     (t:show-result)))

testing.lisp

@@ -4,23 +4,23 @@
 
 (defpackage :scopes/testing
   (:use :common-lisp)
-  (:export #:*tst*
+  (:export #:*test-suite*
            #:test-suite #:show-result
            #:==))
 
 (in-package :scopes/testing)
 
-(defvar *tst* nil)
+(defvar *test-suite* nil)
 
 (defclass test-suite ()
-  ((result :initform nil
+  ((name :reader name :initform "test" :initarg :name)
-           :accessor result)))
+   (result :accessor result :initform nil)))
 
-(defun test-suite ()
+(defun test-suite (&optional (name "test"))
-  (make-instance 'test-suite))
+  (make-instance 'test-suite :name name))
 
 (defun show-result ()
-  (print (result *tst*)))
+  (format t "~a, result: ~a~%" (name *test-suite*) (result *test-suite*)))
 
 (defun == (have wanted)
-  (push (equalp have wanted) (result *tst*)))
+  (push (equalp have wanted) (result *test-suite*)))