r9128: all multiple specs for a given backend

[clsql.git] / tests / test-init.lisp

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index ba69ba0488e1eb8f800b9fc3cffc42cc375ff3ca..585df962cdb3a0dc443e03d9402b04082c40e629 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -16,6 +16,7 @@
 
 (in-package #:clsql-tests)
 
+(defvar *report-stream*)
 (defvar *rt-connection*)
 (defvar *rt-fddl*)
 (defvar *rt-fdml*)
@@ -120,25 +121,23 @@
 
 
 
-(defun test-connect-to-database (db-type)
-  (let ((spec (db-type-spec db-type (read-specs))))
-    (when (db-backend-has-create/destroy-db? db-type)
-      (ignore-errors (destroy-database spec :database-type db-type))
-      (ignore-errors (create-database spec :database-type db-type)))
-    
-
-    (setf *test-database-type* db-type)
-    (when (>= (length spec) 3)
-      (setq *test-database-user* (third spec)))
-    
-    ;; Connect to the database
-    (clsql:connect spec
-                  :database-type db-type
-                  :make-default t
-                  :if-exists :old))
+(defun test-connect-to-database (db-type spec)
+  (when (db-backend-has-create/destroy-db? db-type)
+    (ignore-errors (destroy-database spec :database-type db-type))
+    (ignore-errors (create-database spec :database-type db-type)))
+  
+  (setf *test-database-type* db-type)
+  (when (>= (length spec) 3)
+    (setq *test-database-user* (third spec)))
+  
+  ;; Connect to the database
+  (clsql:connect spec
+                :database-type db-type
+                :make-default t
+                :if-exists :old)
   
   (setf *test-database-underlying-type*
-    (clsql-sys:database-underlying-type *default-database*))
+       (clsql-sys:database-underlying-type *default-database*))
   
   *default-database*)
 
@@ -260,7 +259,10 @@
                     :first-name "Vladamir"
                     :last-name "Putin"
                     :email "putin@soviet.org"))
-  
+
+  ;; sleep to ensure birthdays are no longer at current time
+  (sleep 2) 
+
   ;; Lenin manages everyone
   (clsql:add-to-relation employee2 'manager employee1)
   (clsql:add-to-relation employee3 'manager employee1)
@@ -299,7 +301,13 @@
 
 (defvar *error-count* 0)
 
-(defun run-tests ()
+(defun run-tests-append-report-file (report-file)
+  (with-open-file (out report-file :direction :output
+                      :if-exists :append
+                      :if-does-not-exist :create)
+    (run-tests out)))
+    
+(defun run-tests (&optional (*report-stream* *standard-output*))
   (let ((specs (read-specs))
        (*error-count* 0))
     (unless specs
@@ -307,48 +315,60 @@
       (return-from run-tests :skipped))
     (load-necessary-systems specs)
     (dolist (db-type +all-db-types+)
-      (when (db-type-spec db-type specs)
-       (do-tests-for-backend db-type)))
-    (zerop *error-count*)))
+      (dolist (spec (db-type-spec db-type specs))
+       (do-tests-for-backend db-type spec))))
+  (zerop *error-count*))
 
 (defun load-necessary-systems (specs)
   (dolist (db-type +all-db-types+)
     (when (db-type-spec db-type specs)
       (db-type-ensure-system db-type))))
 
-(defun do-tests-for-backend (db-type)
-  (format t 
-         "~&
-*******************************************************************
-***     Running CLSQL tests with ~A backend.
-*******************************************************************
-" db-type)
-  
-  (test-connect-to-database db-type)
+(defun do-tests-for-backend (db-type spec)
+  (test-connect-to-database db-type spec)
+
   (unwind-protect
       (multiple-value-bind (test-forms skip-tests)
          (compute-tests-for-backend db-type *test-database-underlying-type*)
        
+  (format *report-stream* 
+         "~&
+******************************************************************************
+***     CLSQL Test Suite begun at ~A
+***     ~A
+***     ~A
+***     Database ~A backend~A.
+******************************************************************************
+" 
+(clsql-base:format-time nil (clsql-base:utime->time (get-universal-time)))
+(lisp-implementation-type)
+(lisp-implementation-version)
+db-type
+(if (not (eq db-type *test-database-underlying-type*))
+    (format nil " with underlying type ~A" *test-database-underlying-type*)
+    "")
+)
+  
        (test-initialise-database)
 
        (regression-test:rem-all-tests)
        (dolist (test-form test-forms)
          (eval test-form))
        
-       (let ((remaining (rtest:do-tests)))
+       (let ((remaining (rtest:do-tests *report-stream*)))
          (when (consp remaining)
            (incf *error-count* (length remaining))))
        
-       (format t "~&Tests skipped for ~A:" db-type)
+       (format *report-stream* "~&Tests skipped:")
        (if skip-tests
            (dolist (skipped skip-tests)
-             (format t "~&   ~20A ~A~%" (car skipped) (cdr skipped)))
-         (format t " None~%")))
+             (format *report-stream*
+                     "~&   ~20A ~A~%" (car skipped) (cdr skipped)))
+         (format *report-stream* " None~%")))
     (disconnect)))
 
 
 (defun compute-tests-for-backend (db-type db-underlying-type)
-  (declare (ignore db-type))
   (let ((test-forms '())
        (skip-tests '()))
     (dolist (test-form (append