X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Futils.lisp;h=eb10ec33fe989ae5cd7751f0bd4a48af1ea63972;hp=27cbf94ad6016ced8d4d6a9dd83c5f92a0ad0cdd;hb=d9f41af62750c622945bb17b622a39689ee5b840;hpb=fa32c4233b4a02ae631602dbb0a234ab10df8aaf

diff --git a/tests/utils.lisp b/tests/utils.lisp
index 27cbf94..eb10ec3 100644
--- a/tests/utils.lisp
+++ b/tests/utils.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Author:  Kevin M. Rosenberg
 ;;;; Created: Mar 2002
 ;;;;
-;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
 ;;;;
@@ -24,45 +24,71 @@
 		 :type "config"))
 
 (defvar +all-db-types+
-  #-clisp '(:postgresql :postgresql-socket :sqlite :aodbc :mysql)
-  #+clisp '(:sqlite))
+  '(:postgresql :postgresql-socket :mysql :sqlite :odbc :oracle
+    #+allegro :aodbc))
 
 (defclass conn-specs ()
-  ((aodbc-spec :accessor aodbc-spec :initform nil)
-   (mysql-spec :accessor mysql-spec :initform nil)
-   (pgsql-spec :accessor postgresql-spec :initform nil)
-   (pgsql-socket-spec :accessor postgresql-socket-spec :initform nil)
-   (sqlite-spec :accessor sqlite-spec :initform nil))
+  ((aodbc :accessor aodbc-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)
+   (odbc :accessor odbc-spec :initform nil)
+   (oracle :accessor oracle-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)))
-	  (setf (aodbc-spec specs) (cadr (assoc :aodbc config)))
-	  (setf (mysql-spec specs) (cadr (assoc :mysql config)))
-	  (setf (postgresql-spec specs) (cadr (assoc :postgresql config)))
-	  (setf (postgresql-socket-spec specs) 
-		(cadr (assoc :postgresql-socket config)))
-	  (setf (sqlite-spec specs) (cadr (assoc :sqlite 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)))
 
-(defun db-type-spec (db-type specs)
-  (let ((accessor (intern (concatenate 'string (symbol-name db-type)
-				       (symbol-name '#:-spec))
-			  (find-package '#:clsql-tests))))
-    (funcall accessor specs)))
+(defun spec-fn (db-type)
+  (intern (concatenate 'string (symbol-name db-type)
+		       (symbol-name '#:-spec))
+	  (find-package '#:clsql-tests)))
 
-(defun db-type-ensure-system (db-type)
-  (unless (find-package (symbol-name db-type))
-    (asdf:operate 'asdf:load-op
-		  (intern (concatenate 'string
-				       (symbol-name '#:clsql-)
-				       (symbol-name db-type))))))
+(defun db-type-spec (db-type specs)
+  (funcall (spec-fn db-type) specs))
 
 
+(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
+	    (declare (ignorable utime impl-version))
+	    (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))))))))