r8936: merged classic-tests into tests
[clsql.git] / tests / test-init.lisp
index 31d30306cac32de2fcd50a05c41d47f099fbbf38..db217ecae06e1bffe78612affded35020a90e5d9 100644 (file)
@@ -1,13 +1,9 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; ======================================================================
 ;;;; File:    test-init.lisp
-;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>
+;;;; Authors: Marcus Pearce <m.t.pearce@city.ac.uk>, Kevin Rosenberg
 ;;;; Created: 30/03/2004
-;;;; Updated: $Id: $
-;;;; ======================================================================
-;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; Updated: $Id$
 ;;;;
 ;;;; Initialisation utilities for running regression tests on CLSQL. 
 ;;;;
 
 (in-package #:clsql-tests)
 
+(defvar *rt-connection*)
+(defvar *rt-fddl*)
+(defvar *rt-fdml*)
+(defvar *rt-ooddl*)
+(defvar *rt-oodml*)
+(defvar *rt-syntax*)
+
 (defvar *test-database-type* nil)
-(defvar *test-database-server* "")
-(defvar *test-database-name* "")
-(defvar *test-database-user* "")
-(defvar *test-database-password* "")
+(defvar *test-database-user* nil)
 
 (defclass thing ()
   ((extraterrestrial :initform nil :initarg :extraterrestrial)))
                                   :last-name "Putin"
                                   :email "putin@soviet.org"))
 
-(defun test-database-connection-spec ()
-  (let ((dbserver *test-database-server*)
-        (dbname *test-database-name*)
-        (dbpassword *test-database-password*)
-        (dbtype *test-database-type*)
-        (username *test-database-user*))
-    (case dbtype
-      (:postgresql
-       `("" ,dbname ,username ,dbpassword))
-      (:postgresql-socket
-       `(,dbserver ,dbname ,username ,dbpassword))
-      (:mysql
-       `("" ,dbname ,username ,dbpassword))
-      (:sqlite
-       `(,dbname))
-      (:oracle
-       `(,username ,dbpassword ,dbname))
-      (t
-       (error "Unrecognized database type: ~A" dbtype)))))
-
-(defun test-connect-to-database (database-type)
+(defun test-connect-to-database (database-type spec)
   (setf *test-database-type* database-type)
+  (when (>= (length spec) 3)
+    (setq *test-database-user* (third spec)))
+
   ;; Connect to the database
-  (clsql:connect (test-database-connection-spec)
+  (clsql:connect spec
                 :database-type database-type
                 :make-default t
                 :if-exists :old))
        forms)))
 
 (defun test-initialise-database ()
-    ;; Delete the instance records
+  ;; Delete the instance records
   (with-ignore-errors 
     (clsql:delete-instance-records company1)
     (clsql:delete-instance-records employee1)
   (clsql:update-records-from-instance employee10)
   (clsql:update-records-from-instance company1))
 
-(defun run-tests (backend)
-  (format t "~&Running CLSQL tests with ~A backend.~%" backend)
-  (test-connect-to-database backend)
-  (test-initialise-database)
-  (rtest:do-tests))
+(defun run-tests ()
+  (let ((specs (read-specs)))
+    (unless specs
+      (warn "Not running tests because test configuration file is missing")
+      (return-from run-tests :skipped))
+    (load-necessary-systems specs)
+    (dolist (db-type +all-db-types+)
+      (let ((spec (db-type-spec db-type specs)))
+       (when spec
+         (do-tests-for-backend spec db-type))))))
 
+(defun load-necessary-systems (specs)
+  (dolist (db-type +all-db-types+)
+    (when (db-type-spec db-type specs)
+      (db-type-ensure-system db-type))))
 
+(defun do-tests-for-backend (spec db-type)
+  (format t 
+         "~&
+*******************************************************************
+***     Running CLSQL tests with ~A backend.
+*******************************************************************
+" db-type)
+  (regression-test:rem-all-tests)
+  
+  ;; Tests of clsql-base
+  (ignore-errors (destroy-database spec :database-type db-type))
+  (ignore-errors (create-database spec :database-type db-type))
+  (with-tests (:name "CLSQL")
+    (test-basic spec db-type))
+  
+  (ignore-errors (destroy-database spec :database-type db-type))
+  (ignore-errors (create-database spec :database-type db-type))
+  (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml*
+                       *rt-ooddl* *rt-oodml* *rt-syntax*))
+    (eval test))
+  (test-connect-to-database db-type spec)
+  (test-initialise-database)
+  (rtest:do-tests))