From 778409a8427f96d2d16433ae596fe80e5c2e29e3 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Mon, 20 May 2024 12:22:29 +0200
Subject: [PATCH] work in progress: testing improvements

---
 forge/forge.lisp       |  4 +---
 scratch.lisp           |  3 +++
 test/test-forge.lisp   |  2 +-
 test/test-storage.lisp |  9 +++++----
 testing.lisp           | 16 ++++++++--------
 5 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/forge/forge.lisp b/forge/forge.lisp
index 2b0637d..43646fd 100644
--- a/forge/forge.lisp
+++ b/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)
 
diff --git a/scratch.lisp b/scratch.lisp
index abdfaba..c9fa849 100644
--- a/scratch.lisp
+++ b/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) 
diff --git a/test/test-forge.lisp b/test/test-forge.lisp
index 4a14e31..f219b63 100644
--- a/test/test-forge.lisp
+++ b/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))
diff --git a/test/test-storage.lisp b/test/test-storage.lisp
index 009ccb9..f621674 100644
--- a/test/test-storage.lisp
+++ b/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))
-         (t:*tst* (t:test-suite)))
+         (st (storage:make-storage engine)))
     (setf (storage:schema st) (getf (storage:db-options st) :schema))
     (test-track st)
     (t:show-result)))
diff --git a/testing.lisp b/testing.lisp
index 423b957..7499098 100644
--- a/testing.lisp
+++ b/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
-           :accessor result)))
+  ((name :reader name :initform "test" :initarg :name)
+   (result :accessor result :initform nil)))
 
-(defun test-suite ()
-  (make-instance 'test-suite))
+(defun test-suite (&optional (name "test"))
+  (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*)))