Adding a test that is just micro-seconds for sqlserver, marking usec ones as skip.

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

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 500b89852125ee48a8af06f7882317f69741a313..8ce12ed654669429407a30489f7e992304e77c04 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -63,6 +63,11 @@
 
   *default-database*)
 
+(defun default-suites ()
+  "The default list of tests to run."
+  (append *rt-internal* *rt-connection* *rt-basic* *rt-fddl* *rt-fdml*
+         *rt-ooddl* *rt-oodml* *rt-syntax* *rt-time*))
+
 
 (defvar *error-count* 0)
 (defvar *error-list* nil)
@@ -85,7 +90,8 @@
   (run-function-append-report-file 'run-tests report-file))
 
 
-(defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil))
+(defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil)
+                 (suites (default-suites)))
   ;; clear SQL-OUTPUT cache
   (setq clsql-sys::*output-hash* (make-hash-table :test #'equal))
   (let ((specs (read-specs))
@@ -101,7 +107,7 @@
       (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)))))
+          (do-tests-for-backend db-type spec :suites suites)))))
   (zerop *error-count*))
 
 (defun load-necessary-systems (specs)
@@ -135,18 +141,16 @@
               "")
           ))
 
-(defun do-tests-for-backend (db-type spec)
+(defun do-tests-for-backend (db-type spec &key
+                            (suites (default-suites)) )
   (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*)
+           (compute-tests-for-backend db-type *test-database-underlying-type* :suites suites)
 
            (write-report-banner "Test Suite" db-type *report-stream*
                                (database-name-from-spec spec db-type))
 
-;           (test-initialise-database)
-
            (regression-test:rem-all-tests)
            (dolist (test-form test-forms)
              (eval test-form))
@@ -169,20 +173,28 @@
 
            (format *report-stream* "~&Tests skipped:")
            (if skip-tests
-               (dolist (skipped skip-tests)
-                 (format *report-stream*
-                         "~&   ~30A ~A~%" (car skipped) (cdr skipped)))
+               (let ((max-test-name 20))
+                 (dolist (skipped skip-tests)
+                   (let ((len (length (symbol-name (car skipped)))))
+                     (when (> len max-test-name)
+                       (setq max-test-name len))))
+                 (let ((fmt (format nil "~~&  ~~~DA ~~A~~%" max-test-name)))
+                   (dolist (skipped skip-tests)
+                     (format *report-stream* fmt (car skipped) (cdr skipped)))))
                (format *report-stream* " None~%")))
     (disconnect)))
 
 
-(defun compute-tests-for-backend (db-type db-underlying-type)
+(defun compute-tests-for-backend (db-type db-underlying-type
+                                 &key (suites (default-suites)))
   (let ((test-forms '())
         (skip-tests '()))
-    (dolist (test-form (append *rt-internal* *rt-connection* *rt-basic* *rt-fddl* *rt-fdml*
-                               *rt-ooddl* *rt-oodml* *rt-syntax*))
+    (dolist (test-form (if (listp suites) suites (list suites)))
       (let ((test (second test-form)))
         (cond
+         ((and (not (eql db-underlying-type :mysql))
+               (clsql-sys:in test :connection/query-command))
+          (push (cons test "Known to only work 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))
            (push (cons test "views not supported.") skip-tests))
@@ -270,6 +282,21 @@
                              :oodml/update-instance/6 :oodml/update-instance/7
                              :oodml/db-auto-sync/3 :oodml/db-auto-sync/4))
           (push (cons test ":auto-increment not supported.") skip-tests))
+         ((and (not (member *test-database-underlying-type*
+                           '(:postgresql :postgresql-socket)))
+               (clsql-sys:in test
+                             :time/pg/fdml/usec :time/pg/oodml/no-usec :time/pg/oodml/usec))
+          (push (cons test "Postgres specific test.")
+                skip-tests))
+         ((and (member *test-database-underlying-type* '(:mysql))
+               (clsql-sys:in test :time/cross-platform/msec
+                            :time/cross-platform/usec/no-tz :time/cross-platform/usec/tz))
+          (push (cons test "MySQL doesn't support fractional seconds on timestamp columns (http://forge.mysql.com/worklog/task.php?id=946).")
+                skip-tests))
+         ((and (member *test-database-underlying-type* '(:mssql))
+               (clsql-sys:in test :time/cross-platform/usec/no-tz :time/cross-platform/usec/tz))
+          (push (cons test "MSSQL doesn't support micro-seconds on datetime columns.")
+                skip-tests))
           (t
            (push test-form test-forms)))))
       (values (nreverse test-forms) (nreverse skip-tests))))