r9134: add machine-type to report

[clsql.git] / tests / utils.lisp

diff --git a/tests/utils.lisp b/tests/utils.lisp
index bd51cb84ac32798e27789b7d5cb4fff37d740f07..f73edbc39e6afa37823695cdb8c6c41a2f4a0e76 100644 (file)
--- a/tests/utils.lisp
+++ b/tests/utils.lisp
@@ -24,28 +24,28 @@
                 :type "config"))
 
 (defvar +all-db-types+
-  #-clisp '(:postgresql :postgresql-socket :sqlite :mysql :odbc :aodbc)
+  #-clisp '(:postgresql :postgresql-socket :mysql :sqlite :odbc 
+           #+allegro :aodbc)
   #+clisp '(:sqlite))
 
 (defclass conn-specs ()
-  ((aodbc-spec :accessor aodbc-spec :initform nil)
-   (odbc-spec :accessor odbc-spec :initform nil)
-   (mysql-spec :accessor mysql-spec :initform nil)
-   (postgresql-spec :accessor postgresql-spec :initform nil)
-   (postgresql-socket-spec :accessor postgresql-socket-spec :initform nil)
-   (sqlite-spec :accessor sqlite-spec :initform nil))
+  ((aodbc :accessor aodbc-spec :initform nil)
+   (odbc :accessor odbc-spec :initform nil)
+   (mysql :accessor mysql-spec :initform nil)
+   (postgresql :accessor postgresql-spec :initform nil)
+   (postgresql-socket :accessor postgresql-socket-spec :initform nil)
+   (sqlite :accessor sqlite-spec :initform nil))
   (:documentation "Connection specs for CLSQL testing"))
 
 
 (defun read-specs (&optional (path *config-pathname*))
   (if (probe-file path)
       (with-open-file (stream path :direction :input)
-       (let ((config (read stream))
-             (specs (make-instance 'conn-specs)))
-         (dolist (db-type +all-db-types+)
-           (setf (slot-value specs (spec-fn db-type))
-                 (cadr (assoc db-type config))))
-         specs))
+       (let ((specs (make-instance 'conn-specs)))
+         (dolist (spec (read stream) specs)
+           (push (second spec)
+                 (slot-value specs (intern (symbol-name (first spec))
+                                           (find-package '#:clsql-tests)))))))
       (progn
        (warn "CLSQL test config file ~S not found" path)
        nil)))
@@ -66,3 +66,36 @@
                                       (symbol-name db-type))))))
 
 
+
+(defun summarize-test-report (sexp &optional (output *standard-output*))
+  (flet ((db-title (db-type underlying-db-type)
+          (format nil "~A~A"
+                  db-type 
+                  (if (eq db-type underlying-db-type)
+                      ""
+                      (format nil "/~A" underlying-db-type)))))
+    (with-open-file (in sexp :direction :input)
+      (let ((eof (cons nil nil)))
+       (do ((form (read in nil eof) (read in nil eof)))
+           ((eq form eof))
+         (destructuring-bind (db-type
+                              underlying-db-type
+                              utime
+                              total-tests
+                              failed-tests
+                              impl-type
+                              impl-version
+                              machine-type)
+             form
+           (if failed-tests
+               (format output "~&~A: ~D of ~D tests failed (~A, ~A).~&"
+                       (db-title db-type underlying-db-type)
+                       (length failed-tests)
+                       total-tests
+                       machine-type
+                       impl-type)
+               (format output "~&~A: All ~D tests passed (~A, ~A).~%"
+                       (db-title db-type underlying-db-type)
+                       total-tests
+                       machine-type
+                       impl-type))))))))