X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=classic-tests%2Ftests.lisp;h=d94ed475a314184c56cf26988806c13097598393;hp=76d0dd9f4c935ab9bfda4bdbfadeb18e3d1add69;hb=a89cc325beaf3045a767586e34251aadb09e6d66;hpb=39d3fefaebf35a19a211d1ab6552d7ff54faccd2 diff --git a/classic-tests/tests.lisp b/classic-tests/tests.lisp index 76d0dd9..d94ed47 100644 --- a/classic-tests/tests.lisp +++ b/classic-tests/tests.lisp @@ -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 @@ -18,7 +18,23 @@ ;;; 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: @@ -29,21 +45,24 @@ ;;; (: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*)) @@ -53,29 +72,16 @@ (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 @@ -83,29 +89,29 @@ (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) ) @@ -120,13 +126,13 @@ (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") @@ -135,9 +141,9 @@ ) (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) @@ -146,10 +152,10 @@ (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 @@ -182,9 +188,9 @@ (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)))) @@ -253,18 +259,31 @@ (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)