From 2d52344485c4cb33905086db715eacce87b3f482 Mon Sep 17 00:00:00 2001
From: Russ Tyndall <russ@acceleration.net>
Date: Sat, 23 Jan 2010 15:42:07 -0500
Subject: [PATCH] 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
---
 tests/test-init.lisp | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 7a46089..8bfa2da 100644
--- 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))
-- 
2.34.1