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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 4aa485a..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"))
@@ -190,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)
@@ -212,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))
@@ -367,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 ()