made run-tests take a :suites arg

Also compute-tests-for-backend and do-tests-for-backend, take a :suites arg
where you can specify the *rt-* variable "suites" you wish to run
defaulting to all of them

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 7a46089b16b820e7fab2420dd393dff3d5fe8b3f..8bfa2dafd08acda7a0a1e1a952e8139228ae3217 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))
@@ -176,11 +180,11 @@
     (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))