X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=f13f1cc3058d208478cf8956c57c04d1c8cc4088;hb=92cad9a9410b8e481987b90cc4f5edd8cc85e7ce;hp=88322083db113eb9334bcb6c8081d2f9ff7c8073;hpb=4f1164a3bc99829cb784b4fc4993fbd266ac78d9;p=clsql.git

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 8832208..f13f1cc 100644
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -41,29 +41,41 @@
 (defvar *test-report-width* 80 "Width of test report in ems.")
 
 
-(defun test-connect-to-database (db-type spec)
+(defun find-test-connection-spec (db-type &key position)
+  (nth (or position 0)
+       (db-type-spec db-type (read-specs))))
+
+(defun test-connect
+    (db-type
+     &key position pool
+     (spec (find-test-connection-spec db-type :position position))
+     )
+  (setf *test-database-type* db-type)
+  (setf *test-database-user*
+        (cond
+          ((member db-type '(:oracle :odbc :aodbc)) (second spec))
+          ((>= (length spec) 3) (third spec))))
+  (let ((*default-database* (clsql:connect
+                             spec
+                             :database-type db-type
+                             :make-default t
+                             :if-exists :old
+                             :pool pool)))
+    (setf *test-database-underlying-type*
+          (clsql-sys:database-underlying-type *default-database*))
+    *default-database*))
+
+(defun test-setup-database (db-type &key (spec (find-test-connection-spec db-type)))
   (when (clsql-sys: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)
-  (setf *test-database-user*
-    (cond
-     ((member db-type '(:oracle :odbc :aodbc)) (second spec))
-     ((>= (length spec) 3) (third spec))))
-
   ;; Connect to the database
-  (clsql:connect spec
-                 :database-type db-type
-                 :make-default t
-                 :if-exists :old)
+  (test-connect db-type :spec spec)
 
   ;; Ensure database is empty
   (truncate-database :database *default-database*)
 
-  (setf *test-database-underlying-type*
-        (clsql-sys:database-underlying-type *default-database*))
-
   ;; If Postgres, turn off notices to console
   (when (eql db-type :postgresql)
     (clsql:execute-command "SET client_min_messages = WARNING"))
@@ -124,8 +136,10 @@
           (dolist (spec (db-type-spec db-type specs))
             (let ((*test-connection-spec* spec)
                   (*test-connection-db-type* db-type))
-              (do-tests-for-backend db-type spec :suites suites)))))))
-  (zerop *error-count*))
+              (format report-stream "~%~%Start Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2)))
+              (do-tests-for-backend db-type spec :suites suites)
+              (format report-stream  "~%~%Finished Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2))))))))
+    (zerop *error-count*)))
 
 (defun load-necessary-systems (specs)
   (dolist (db-type +all-db-types+)
@@ -188,7 +202,7 @@
 
 (defun do-tests-for-backend (db-type spec &key
 			     (suites (default-suites)) )
-  (test-connect-to-database db-type spec)
+  (test-setup-database db-type :spec spec)
   (unwind-protect
        (multiple-value-bind (test-forms skip-tests)
            (compute-tests-for-backend db-type *test-database-underlying-type* :suites suites)
@@ -210,7 +224,7 @@
                      ;; word-wrap the reason string field
                      (let* ((test (car skipped))
                             (reason (cdr skipped))
-                            (rlen (length reason))
+                            ;; (rlen (length reason))
                             (rwidth (max 20 (- (or *test-report-width* 80) max-test-name 3)))
                             (rwords (clsql-sys::delimited-string-to-list reason #\space t))
                             (rformat (format nil "~~{~~<~%~~1,~D:;~~A~~> ~~}" rwidth))
@@ -365,8 +379,9 @@
   "Rapid load for interactive testing."
   (when *default-database*
       (disconnect :database *default-database*))
-  (test-connect-to-database type (nth position (db-type-spec type (read-specs))))
-  ;(test-initialise-database)
+  (test-setup-database
+   type
+   :spec (find-test-connection-spec type :position position))
   *default-database*)
 
 (defun rl ()