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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index f13f1cc..8312784 100644
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -46,24 +46,31 @@
        (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*
+    (&key
+     (db-type *test-database-type* db-type-p)
+     position pool spec)
+  (unless spec
+    (setf spec
+          (or (and (null db-type-p) *test-connection-spec*)
+              (find-test-connection-spec db-type :position position))))
+  (when *default-database*
+    (disconnect :database *default-database*))
+  (setf *test-database-type* db-type
+        *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*))
+          ((>= (length spec) 3) (third spec)))
+        *test-connection-spec* spec
+        *default-database*
+        (clsql:connect
+         spec
+         :database-type db-type
+         :make-default t
+         :if-exists :old
+         :pool pool)
+        *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)
@@ -71,8 +78,7 @@
     (ignore-errors (create-database spec :database-type db-type)))
 
   ;; Connect to the database
-  (test-connect db-type :spec spec)
-
+  (test-connect :db-type db-type :spec spec)
   ;; Ensure database is empty
   (truncate-database :database *default-database*)
 
@@ -133,12 +139,10 @@
     (let ((suites (intersection suites (default-suites))))
       (when suites
         (dolist (db-type +all-db-types+)
-          (dolist (spec (db-type-spec db-type specs))
-            (let ((*test-connection-spec* spec)
-                  (*test-connection-db-type* db-type))
-              (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))))))))
+          (dolist (spec (db-type-spec db-type specs))            
+            (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)
@@ -212,7 +216,9 @@
 
          (%do-tests test-forms db-type)
 
-           (format *report-stream* "~&Tests skipped:")
+         (format *report-stream* "~&~D of ~D Tests skipped:"
+                 (length skip-tests)
+                 (length test-forms))
            (if skip-tests
                (let ((max-test-name (length (symbol-name (caar skip-tests)))))
                  (dolist (skipped (cdr skip-tests))
@@ -250,7 +256,8 @@
         (cond
 	  ((and (not (eql db-underlying-type :mysql))
 		(clsql-sys:in test :connection/query-command
-                              :basic/reallybigintegers/1))
+                              :basic/reallybigintegers/1
+                              :connection/pool/procedure-mysql))
 	   (push (cons test "known to work only in MySQL as yet.") skip-tests))
           ((and (null (clsql-sys:db-type-has-views? db-underlying-type))
                 (clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
@@ -377,8 +384,6 @@
 
 (defun rapid-load (type &optional (position 0))
   "Rapid load for interactive testing."
-  (when *default-database*
-      (disconnect :database *default-database*))
   (test-setup-database
    type
    :spec (find-test-connection-spec type :position position))