r8935: example dir
[clsql.git] / classic-tests / tests.lisp
index 76d0dd9f4c935ab9bfda4bdbfadeb18e3d1add69..d94ed475a314184c56cf26988806c13097598393 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:          tests.lisp
+;;;; Name:          classic-tests.lisp
 ;;;; Purpose:       Automated test of CLSQL using ACL's tester
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 
 ;;; This test suite looks for a configuration file named ".clsql-test.config"
 ;;; located in the users home directory.
-;;;
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; File:    tests.lisp
+;;;; Author: Kevin Rosenberg
+;;;; $Id$
+;;;;
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+;;; You need a file named "~/.clsql-tests.config"
+
 ;;; This file contains a single a-list that specifies the connection
 ;;; specs for each database type to be tested. For example, to test all
 ;;; platforms, a sample "test.config" may look like:
 ;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password"))
 ;;;  (:sqlite ("path-to-sqlite-db")))
 
-(in-package :clsql-tests)
+(in-package #:clsql-classic-tests)
 
 (defvar *config-pathname*
   (make-pathname :defaults (user-homedir-pathname)
                 :name ".clsql-test"
                 :type "config"))
 
+(defvar +all-db-types+
+  #-clisp '(:postgresql :postgresql-socket :sqlite :aodbc :mysql)
+  #+clisp '(:sqlite))
 
 (defclass conn-specs ()
-  ((aodbc-spec :accessor aodbc-spec)
-   (mysql-spec :accessor mysql-spec)
-   (pgsql-spec :accessor pgsql-spec)
-   (pgsql-socket-spec :accessor pgsql-socket-spec)
-   (sqlite-spec :accessor sqlite-spec))
-  (:documentation "Test fixture for CLSQL testing"))
+  ((aodbc-spec :accessor aodbc-spec :initform nil)
+   (mysql-spec :accessor mysql-spec :initform nil)
+   (pgsql-spec :accessor postgresql-spec :initform nil)
+   (pgsql-socket-spec :accessor postgresql-socket-spec :initform nil)
+   (sqlite-spec :accessor sqlite-spec :initform nil))
+  (:documentation "Connection specs for CLSQL testing"))
 
 
 (defun read-specs (&optional (path *config-pathname*))
              (specs (make-instance 'conn-specs)))
          (setf (aodbc-spec specs) (cadr (assoc :aodbc config)))
          (setf (mysql-spec specs) (cadr (assoc :mysql config)))
-         (setf (pgsql-spec specs) (cadr (assoc :postgresql config)))
-         (setf (pgsql-socket-spec specs) 
+         (setf (postgresql-spec specs) (cadr (assoc :postgresql config)))
+         (setf (postgresql-socket-spec specs) 
                (cadr (assoc :postgresql-socket config)))
          (setf (sqlite-spec specs) (cadr (assoc :sqlite config)))
          specs))
       (progn
-       (warn "CLSQL tester config file ~S not found" path)
+       (warn "CLSQL test config file ~S not found" path)
        nil)))
 
-(defmethod mysql-table-test ((test conn-specs))
-  (test-table (mysql-spec test) :mysql))
-
-(defmethod aodbc-table-test ((test conn-specs))
-  (test-table (aodbc-spec test) :aodbc))
-
-(defmethod pgsql-table-test ((test conn-specs))
-  (test-table (pgsql-spec test) :postgresql))
-
-(defmethod pgsql-socket-table-test ((test conn-specs))
-  (test-table (pgsql-socket-spec test) :postgresql-socket))
-
-(defmethod sqlite-table-test ((test conn-specs))
-  (test-table (sqlite-spec test) :sqlite))
+(defgeneric test-table (spec type))
 
 (defmethod test-table (spec type)
   (when spec
       (unwind-protect
           (progn
             (create-test-table db)
-            (dolist (row (query "select * from test_clsql" :database db :types :auto))
+            (dolist (row (query "select * from test_clsql" :database db :result-types :auto))
               (test-table-row row :auto type))
-            (dolist (row (query "select * from test_clsql" :database db :types nil))
+            (dolist (row (query "select * from test_clsql" :database db :result-types nil))
               (test-table-row row nil type))
             (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-                                            :database db :types :auto)
+                                            :database db :result-types :auto)
                   do (test-table-row row :auto type))
             (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-                                            :database db :types nil)
+                                            :database db :result-types nil)
                   do (test-table-row row nil type))
             (loop for row in (map-query 'list #'list "select * from test_clsql" 
-                                        :database db :types nil)
+                                        :database db :result-types nil)
                   do (test-table-row row nil type))
             (loop for row in (map-query 'list #'list "select * from test_clsql" 
-                                        :database db :types :auto)
+                                        :database db :result-types :auto)
                 do (test-table-row row :auto type))
             (test (map-query nil #'list "select * from test_clsql" 
-                             :database db :types :auto)
+                             :database db :result-types :auto)
                   nil
                   :fail-info "Expected NIL result from map-query nil")
             (do-query ((int float bigint str) "select * from test_clsql")
               (test-table-row (list int float bigint str) nil type))
-            (do-query ((int float bigint str) "select * from test_clsql" :types :auto)
+            (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto)
               (test-table-row (list int float bigint str) :auto type))
             (drop-test-table db)
             )
       (unwind-protect
           (progn
             (create-test-table db)
-            (dolist (row (query "select * from test_clsql" :database db :types nil))
+            (dolist (row (query "select * from test_clsql" :database db :result-types nil))
               (test-table-row row nil type))
             (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-                                            :database db :types nil)
+                                            :database db :result-types nil)
                   do (test-table-row row nil type))
             (loop for row in (map-query 'list #'list "select * from test_clsql" 
-                                        :database db :types nil)
+                                        :database db :result-types nil)
                   do (test-table-row row nil type))
 
             (do-query ((int float bigint str) "select * from test_clsql")
             )
        (disconnect :database db)))))
 
-(defmethod mysql-low-level ((test conn-specs))
+(defun mysql-low-level (specs)
   #-clisp
-  (let ((spec (mysql-spec test)))
+  (let ((spec (mysql-spec specs)))
     (when spec
       (let ((db (clsql-mysql::database-connect spec :mysql)))
        (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
        (dotimes (i 10)
          (clsql-mysql::database-execute-command
           (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
-                  i (clsql:number-to-sql-string (sqrt i))
-                  (clsql:number-to-sql-string (sqrt i)))
+                  i (clsql-base:number-to-sql-string (sqrt i))
+                  (clsql-base:number-to-sql-string (sqrt i)))
           db))
-       (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
+       (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :result-types nil)))
          (test (mysql:mysql-num-rows
                 (clsql-mysql::mysql-result-set-res-ptr res))
                10
       (clsql:execute-command
        (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
               test-int
-              (number-to-sql-string test-flt)
+              (clsql-base:number-to-sql-string test-flt)
               (transform-bigint-1 test-int)
-              (number-to-sql-string test-flt)
+              (clsql-base:number-to-sql-string test-flt)
               )
        :database db))))
 
 (defun drop-test-table (db)
   (clsql:execute-command "DROP TABLE test_clsql" :database db))
 
-(defun run-tests ()
-    (let ((specs (read-specs)))
-      (unless specs
-       (warn "Not running test because test configuration file is missing")
-       (return-from run-tests :skipped))
-      (with-tests (:name "CLSQL")
-       (mysql-low-level specs)
-       (mysql-table-test specs)
-       (pgsql-table-test specs)
-       (pgsql-socket-table-test specs)
-       (aodbc-table-test specs)
-       (sqlite-table-test specs)
-      ))
-    t)
+(defun db-type-spec (db-type specs)
+  (let ((accessor (intern (concatenate 'string (symbol-name db-type)
+                                      (symbol-name '#:-spec))
+                         (find-package '#:clsql-classic-tests))))
+    (funcall accessor specs)))
 
+(defun db-type-ensure-system (db-type)
+  (unless (find-package (symbol-name db-type))
+    (asdf:operate 'asdf:load-op
+                 (intern (concatenate 'string
+                                      (symbol-name '#:clsql-)
+                                      (symbol-name db-type))))))
+
+(defun run-tests ()
+  (let ((specs (read-specs)))
+    (unless specs
+      (warn "Not running test because test configuration file is missing")
+      (return-from run-tests :skipped))
+    (mysql-low-level specs)
+    (with-tests (:name "CLSQL")
+      (dolist (db-type +all-db-types+)
+       (let ((spec (db-type-spec db-type specs)))
+         (when spec
+           (db-type-ensure-system db-type)
+           (ignore-errors (destroy-database spec db-type))
+           (ignore-errors (create-database spec db-type))
+           (test-table spec db-type))))))
+  t)