From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 2 May 2003 03:08:58 +0000 (+0000)
Subject: r4733: *** empty log message ***
X-Git-Tag: v3.8.6~864
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=8d558ce162d1360f92e4d65d054e2f61c786319e

r4733: *** empty log message ***
---

diff --git a/base/cmucl-compat.lisp b/base/cmucl-compat.lisp
index 8b2b5a5..8e7df71 100644
--- a/base/cmucl-compat.lisp
+++ b/base/cmucl-compat.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: cmucl-compat.lisp,v 1.3 2002/10/21 07:45:49 kevin Exp $
+;;;; $Id: cmucl-compat.lisp,v 1.4 2003/05/02 03:05:54 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -16,7 +16,6 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (in-package :cl-user)
 
 (defpackage :cmucl-compat
@@ -56,9 +55,11 @@ Needs to be a macro to overwrite value of VEC."
       ((typep ,vec 'simple-array)
        (let ((,new-vec (make-array ,len :element-type
 				   (array-element-type ,vec))))
-	 (dotimes (i ,len)
-	   (declare (fixnum i))
-	   (setf (aref ,new-vec i) (aref ,vec i)))
+	 (check-type ,len fixnum)
+	 (locally (declare (speed 3) (safety 0) (space 0)) 
+	   (dotimes (i ,len)
+	     (declare (fixnum i))
+	     (setf (aref ,new-vec i) (aref ,vec i))))
 	 (setq ,vec ,new-vec)))
       ((typep ,vec 'vector)
 	(setf (fill-pointer ,vec) ,len)
@@ -68,27 +69,10 @@ Needs to be a macro to overwrite value of VEC."
        )))
 
 
-
-#-(or cmu sbcl scl)
+#-(or cmu scl)
 (defun make-sequence-of-type (type length)
   "Returns a sequence of the given TYPE and LENGTH."
-  (declare (fixnum length))
-  (case type
-    (list 
-     (make-list length))
-    ((bit-vector simple-bit-vector) 
-     (make-array length :element-type '(mod 2)))
-    ((string simple-string base-string simple-base-string)
-     (make-string length))
-    (simple-vector 
-     (make-array length))
-    ((array simple-array vector)
-     (if (listp type)
-	 (make-array length :element-type (cadr type))
-       (make-array length)))
-    (t
-     (make-sequence-of-type (result-type-or-lose type t) length))))
-
+  (make-sequence type length))
 
 #+(or cmu scl)
 (if (fboundp 'lisp::make-sequence-of-type)
@@ -97,11 +81,7 @@ Needs to be a macro to overwrite value of VEC."
   (defun make-sequence-of-type (type len)
     (system::make-sequence-of-type type len)))
 
-#+sbcl
-(defun make-sequence-of-type (type len)
-  (sb-impl::make-sequence-of-type type len))
-
-#-(or cmu sbcl scl)
+#-(or cmu scl)
 (defun result-type-or-lose (type nil-ok)
   (unless (or type nil-ok)
     (error "NIL output type invalid for this sequence function"))
@@ -121,7 +101,3 @@ Needs to be a macro to overwrite value of VEC."
 #+(or cmu scl)
 (defun result-type-or-lose (type nil-ok)
   (lisp::result-type-or-lose type nil-ok))
-
-#+sbcl
-(defun result-type-or-lose (type nil-ok)
-  (sb-impl::result-type-or-lose type nil-ok))
diff --git a/clsql-tests.asd b/clsql-tests.asd
new file mode 100644
index 0000000..1988302
--- /dev/null
+++ b/clsql-tests.asd
@@ -0,0 +1,40 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          clsql-tests.asd
+;;;; Purpose:       ASDF system definitionf for clsql testing package
+;;;; Author:        Kevin M. Rosenberg
+;;;; Date Started:  Apr 2003
+;;;;
+;;;; $Id: clsql-tests.asd,v 1.1 2003/05/02 03:05:54 kevin Exp $
+;;;; *************************************************************************
+
+(defpackage #:clsql-tests-system
+  (:use #:asdf #:cl))
+(in-package #:clsql-tests-system)
+
+(defsystem clsql-tests
+  :name "clsql-tests"
+  :author "Kevin Rosenberg <kevin@rosenberg.net>"
+  :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
+  :licence "Lessor Lisp General Public License"
+  :description "Testing suite for CLSQL"
+
+  :depends-on (:clsql :clsql-mysql :clsql-postgresql :clsql-postgresql-socket
+		      #+allegro :clsql-aodbc)
+  :components
+  ((:module tests
+	    :components
+	    ((:file "rt")
+	     (:file "acl-compat-tester")
+	     (:file "package" :depends-on ("rt"))
+;;	     (:file "tables" :depends-on ("package")))
+	     (:file "tests" :depends-on ("package" "acl-compat-tester")))
+	    )))
+
+(defmethod perform ((o test-op) (c (eql (find-system :clsql-tests))))
+  (or (funcall (intern (symbol-name '#:do-tests)
+		       (find-package '#:regression-test)))
+      (error "test-op failed")))
+
diff --git a/clsql.asd b/clsql.asd
index 0db72bf..55562fd 100644
--- a/clsql.asd
+++ b/clsql.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: clsql.asd,v 1.16 2002/11/08 16:51:50 kevin Exp $
+;;;; $Id: clsql.asd,v 1.17 2003/05/02 03:05:54 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -20,16 +20,14 @@
 
 #+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem :clsql
-  :name "cl-sql"
-  :author "Kevin M. Rosenberg <kmr@debian.org>"
-  :version "0.9.2"
+  :name "clsql"
+  :author "Kevin Rosenberg <kevin@rosenberg.net>"
   :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
+  :version "1.5.x"
   :licence "Lessor Lisp General Public License"
   :description "Common Lisp SQL Interface Library"
   :long-description "cl-sql package provides the high-level interface for the CLSQL system."
   
-  :perform (load-op :after (op clsql)
-		    (pushnew :clsql cl:*features*))
   :components
   ((:module :sql
 	    :components
@@ -42,3 +40,8 @@
 	     (:file "usql" :depends-on ("sql")))))
   :depends-on (:clsql-base)
   )
+
+#+(or allegro lispworks cmu sbcl openmcl mcl scl)
+(defmethod perform ((o test-op) (c (eql (find-system :clsql))))
+  (oos 'load-op 'clsql-tests)
+  (oos 'test-op 'clsql-tests))
diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp
index 641764b..ed7bb24 100644
--- a/db-aodbc/aodbc-sql.lisp
+++ b/db-aodbc/aodbc-sql.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aodbc-sql.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
+;;;; $Id: aodbc-sql.lisp,v 1.2 2003/05/02 03:05:54 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,7 +21,7 @@
 
 
 ;; interface foreign library loading routines
-(defmethod database-type-library-loaded ((database-type (eql :aodbc)))
+(defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :aodbc)))
   "T if foreign library was able to be loaded successfully. "
   (when (find-package :dbi) ;; finds Allegro's DBI (AODBC) package
     t))
@@ -145,6 +145,6 @@
 	      (setf (car rest) elem))
 	list))))
 
-		       
+#+ignore		       
 (when (clsql-base-sys:database-type-library-loaded :aodbc)
   (clsql-base-sys:initialize-database-type :database-type :aodbc))
diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp
index 658addc..9e9b10e 100644
--- a/db-postgresql-socket/postgresql-socket-api.lisp
+++ b/db-postgresql-socket/postgresql-socket-api.lisp
@@ -9,7 +9,7 @@
 ;;;;                
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-socket-api.lisp,v 1.3 2003/03/02 20:02:02 kevin Exp $
+;;;; $Id: postgresql-socket-api.lisp,v 1.4 2003/05/02 03:05:54 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -40,12 +40,15 @@
      (:float4 700)
      (:float8 701)))
 
-(defmethod database-type-library-loaded ((database-type
+(defmethod clsql-base-sys:database-type-library-loaded ((database-type
 					  (eql :postgresql-socket)))
   "T if foreign library was able to be loaded successfully. Always true for
 socket interface"
   t)
-				      
+
+(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
+  t)
+
 
 ;;; Message I/O stuff
 
diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index acd93c3..a9cb8f5 100644
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -8,7 +8,7 @@
 ;;;;                Original code by Pierre R. Mai 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-socket-sql.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
+;;;; $Id: postgresql-socket-sql.lisp,v 1.2 2003/05/02 03:05:54 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -30,11 +30,6 @@
 
 ;; interface foreign library loading routines
 
-(defmethod database-type-library-loaded ((database-type (eql :postgresql-socket)))
-  t)
-
-(defmethod clsql-base-sys:database-type-load-foreign ((database-type (eql :postgresql-socket)))
-  t)
 
 (clsql-base-sys:database-type-load-foreign :postgresql-socket)
 
diff --git a/debian/changelog b/debian/changelog
index 804e471..ca297b8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,11 @@
+cl-sql (1.5.0-1) unstable; urgency=low
+
+  * Update SBCL support in cmucl-compat package.
+  * Use debian/compat rather than DH_COMPAT
+  * Add cl-sql-tests binary with test suite
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu,  1 May 2003 16:23:37 -0600
+
 cl-sql (1.4.6-1) unstable; urgency=low
 
   * Documentation fix
diff --git a/debian/cl-sql-tests.docs b/debian/cl-sql-tests.docs
new file mode 100644
index 0000000..8a81e98
--- /dev/null
+++ b/debian/cl-sql-tests.docs
@@ -0,0 +1 @@
+tests/README
diff --git a/debian/compat b/debian/compat
new file mode 100644
index 0000000..b8626c4
--- /dev/null
+++ b/debian/compat
@@ -0,0 +1 @@
+4
diff --git a/debian/control b/debian/control
index ddab432..9b198e1 100644
--- a/debian/control
+++ b/debian/control
@@ -32,7 +32,7 @@ Description: Common UFFI functions for CLSQL database backends
 
 Package: cl-sql-mysql
 Architecture: any
-Depends: cl-sql-base (>= ${Source-Version}), libmysqlclient12, cl-sql-uffi (>= ${Source-Version})
+Depends: cl-sql-base (>= ${Source-Version}), libmysqlclient10, cl-sql-uffi (>= ${Source-Version})
 Provides: cl-sql-backend
 Description: CLSQL database backend, MySQL
  This package enables you to use the CLSQL data access package
@@ -61,3 +61,16 @@ Provides: cl-sql-backend
 Description: CLSQL database backend, PostgreSQL
  This package enables you to use the CLSQL data access package
  with PostgreSQL databases via a socket interface.
+
+Package: cl-sql-tests
+Architecture: all
+Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql
+Suggests: acl-installer, libmyodbc, unixodbc,cl-sql-aodbc 
+Description: Testing suite for CLSQL
+ This package contains a test suite for CLSQL. It requires manual
+ configuration of MySQL and PostgreSQL databases to execute.
+ A configured, licensed version of AllegroCL with ODBC setup is
+ required to test the clsql-aodbc interface. See the
+ /usr/share/doc/cl-sql-tests/README file if you want to try
+ running these regression tests.
+
diff --git a/debian/rules b/debian/rules
index 41d3289..299e58e 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,7 +1,5 @@
 #!/usr/bin/make -f
 
-export DH_COMPAT=4
-
 plain-pkg	:= clsql
 
 pkg		:= cl-sql
@@ -11,7 +9,8 @@ pkg-mysql	:= cl-sql-mysql
 pkg-pg		:= cl-sql-postgresql
 pkg-pg-socket	:= cl-sql-postgresql-socket
 pkg-aodbc	:= cl-sql-aodbc
-all-pkgs	:= $(pkg) $(pkg-base) $(pkg-uffi) $(pkg-mysql) $(pkg-pg) $(pkg-pg-socket) $(pkg-aodbc)
+pkg-tests	:= cl-sql-tests
+all-pkgs	:= $(pkg) $(pkg-base) $(pkg-uffi) $(pkg-mysql) $(pkg-pg) $(pkg-pg-socket) $(pkg-aodbc) $(pkg-tests)
 
 
 UPSTREAM_VER	:= $(shell sed -n -e "s/${pkg} (\(.*\)-[0-9A-Za-z\.]).*/\1/p" < debian/changelog |head -1)
@@ -26,6 +25,7 @@ srcs-mysql-so	:=  $(wildcard db-mysql/*.so)
 srcs-pg		:= $(wildcard db-postgresql/*.lisp)
 srcs-pg-socket	:= $(wildcard db-postgresql-socket/*.lisp)
 srcs-aodbc	:= $(wildcard db-aodbc/*.lisp)
+srcs-tests	:= $(wildcard tests/*.lisp)
 
 clc-base	:= usr/share/common-lisp
 clc-source	:= $(clc-base)/source
@@ -50,6 +50,8 @@ clc-pg-socket 	:= $(clc-source)/clsql-postgresql-socket
 lispdir-pg-socket := $(clc-pg-socket)/db-postgresql-socket
 clc-aodbc	:= $(clc-source)/clsql-aodbc
 lispdir-aodbc	:= $(clc-aodbc)/db-aodbc
+clc-tests	:= $(clc-source)/clsql-tests
+lispdir-tests	:= $(clc-tests)/tests
 
 configure: configure-stamp
 configure-stamp:
@@ -100,6 +102,7 @@ install: build
 	dh_installdirs -p $(pkg-pg-socket) $(lispdir-pg-socket)
 	dh_installdirs -p $(pkg-mysql) $(lispdir-mysql) $(sodir-mysql)
 	dh_installdirs -p $(pkg-aodbc) $(lispdir-aodbc)
+	dh_installdirs -p $(pkg-tests) $(lispdir-tests)
 
 	# Main package
 	dh_install -p $(pkg) $(srcs) $(lispdir-sql)
@@ -125,6 +128,9 @@ install: build
 	dh_install -p $(pkg-aodbc) $(srcs-aodbc) $(lispdir-aodbc)
 	dh_install -p $(pkg-aodbc) clsql-aodbc.asd $(clc-aodbc)
 
+	dh_install -p $(pkg-tests) $(srcs-tests) $(lispdir-tests)
+	dh_install -p $(pkg-tests) clsql-tests.asd $(clc-tests)
+
 	# CLC Systems
 	dh_link -p $(pkg) $(clc-clsql)/clsql.asd $(clc-systems)/clsql.asd
 	dh_link -p $(pkg-base) $(clc-base)/clsql-base.asd $(clc-systems)/clsql-base.asd
@@ -133,10 +139,7 @@ install: build
 	dh_link -p $(pkg-pg) $(clc-pg)/clsql-postgresql.asd $(clc-systems)/clsql-postgresql.asd
 	dh_link -p $(pkg-pg-socket) $(clc-pg-socket)/clsql-postgresql-socket.asd $(clc-systems)/clsql-postgresql-socket.asd
 	dh_link -p $(pkg-aodbc) $(clc-aodbc)/clsql-aodbc.asd $(clc-systems)/clsql-aodbc.asd
-
-	# Test suite
-	dh_installdirs -p $(pkg) $(doc-dir)/html $(doc-dir)/test-suite
-	dh_install -p $(pkg) test-suite/tester-clsql.lisp test-suite/acl-compat-tester.lisp $(doc-dir)/test-suite
+	dh_link -p $(pkg-tests) $(clc-tests)/clsql-tests.asd $(clc-systems)/clsql-tests.asd
 
 	# Documentation
 	rm -rf doc/html
diff --git a/test-suite/.cvsignore b/test-suite/.cvsignore
deleted file mode 100755
index 102a86f..0000000
--- a/test-suite/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-test.config
diff --git a/test-suite/acl-compat-tester.lisp b/test-suite/acl-compat-tester.lisp
deleted file mode 100644
index b775ea9..0000000
--- a/test-suite/acl-compat-tester.lisp
+++ /dev/null
@@ -1,600 +0,0 @@
-;; tester.cl
-;; A test harness for Allegro CL.
-;;
-;; copyright (c) 1985-1986 Franz Inc, Alameda, CA
-;; copyright (c) 1986-2001 Franz Inc, Berkeley, CA - All rights reserved.
-;;
-;; This code is free software; you can redistribute it and/or
-;; modify it under the terms of the version 2.1 of
-;; the GNU Lesser General Public License as published by 
-;; the Free Software Foundation, as clarified by the Franz
-;; preamble to the LGPL found in
-;; http://opensource.franz.com/preamble.html.
-;;
-;; This code is distributed in the hope that it will be useful,
-;; but without any warranty; without even the implied warranty of
-;; merchantability or fitness for a particular purpose.  See the GNU
-;; Lesser General Public License for more details.
-;;
-;; Version 2.1 of the GNU Lesser General Public License can be
-;; found at http://opensource.franz.com/license.html.
-;; If it is not present, you can access it from
-;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer
-;; version) or write to the Free Software Foundation, Inc., 59 Temple
-;; Place, Suite 330, Boston, MA  02111-1307  USA
-;;
-;;;; from the original ACL 6.1 sources:
-;; $Id: acl-compat-tester.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
-
-
-(defpackage :util.test
-  (:use :common-lisp)
-  (:shadow #:test)
-  (:export
-;;;; Control variables:
-   #:*break-on-test-failures*
-   #:*error-protect-tests*
-   #:*test-errors*
-   #:*test-successes*
-   #:*test-unexpected-failures*
-
-;;;; The test macros:
-   #:test
-   #:test-error
-   #:test-no-error
-   #:test-warning
-   #:test-no-warning
-   
-   #:with-tests
-   ))
-
-(in-package :util.test)
-
-#+cmu
-(unless (find-class 'break nil)
-  (define-condition break (simple-condition) ()))
-
-(define-condition simple-break (error simple-condition) ())
-
-;; the if* macro used in Allegro:
-;;
-;; This is in the public domain... please feel free to put this definition
-;; in your code or distribute it with your version of lisp.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
-
-(defmacro if* (&rest args)
-   (do ((xx (reverse args) (cdr xx))
-	(state :init)
-	(elseseen nil)
-	(totalcol nil)
-	(lookat nil nil)
-	(col nil))
-       ((null xx)
-	(cond ((eq state :compl)
-	       `(cond ,@totalcol))
-	      (t (error "if*: illegal form ~s" args))))
-       (cond ((and (symbolp (car xx))
-		   (member (symbol-name (car xx))
-			   if*-keyword-list
-			   :test #'string-equal))
-	      (setq lookat (symbol-name (car xx)))))
-
-       (cond ((eq state :init)
-	      (cond (lookat (cond ((string-equal lookat "thenret")
-				   (setq col nil
-					 state :then))
-				  (t (error
-				      "if*: bad keyword ~a" lookat))))
-		    (t (setq state :col
-			     col nil)
-		       (push (car xx) col))))
-	     ((eq state :col)
-	      (cond (lookat
-		     (cond ((string-equal lookat "else")
-			    (cond (elseseen
-				   (error
-				    "if*: multiples elses")))
-			    (setq elseseen t)
-			    (setq state :init)
-			    (push `(t ,@col) totalcol))
-			   ((string-equal lookat "then")
-			    (setq state :then))
-			   (t (error "if*: bad keyword ~s"
-					      lookat))))
-		    (t (push (car xx) col))))
-	     ((eq state :then)
-	      (cond (lookat
-		     (error
-		      "if*: keyword ~s at the wrong place " (car xx)))
-		    (t (setq state :compl)
-		       (push `(,(car xx) ,@col) totalcol))))
-	     ((eq state :compl)
-	      (cond ((not (string-equal lookat "elseif"))
-		     (error "if*: missing elseif clause ")))
-	      (setq state :init)))))
-
-
-
-
-(defvar *break-on-test-failures* nil
-  "When a test failure occurs, common-lisp:break is called, allowing
-interactive debugging of the failure.")
-
-(defvar *test-errors* 0
-  "The value is the number of test errors which have occurred.")
-(defvar *test-successes* 0
-  "The value is the number of test successes which have occurred.")
-(defvar *test-unexpected-failures* 0
-  "The value is the number of unexpected test failures which have occurred.")
-
-(defvar *error-protect-tests* nil
-  "Protect each test from errors.  If an error occurs, then that will be
-taken as a test failure unless test-error is being used.")
-
-(defmacro test-values-errorset (form &optional announce catch-breaks)
-  ;; internal macro
-  (let ((g-announce (gensym))
-	(g-catch-breaks (gensym)))
-    `(let* ((,g-announce ,announce)
-	    (,g-catch-breaks ,catch-breaks))
-       (handler-case (cons t (multiple-value-list ,form))
-	 (condition (condition)
-	   (if* (and (null ,g-catch-breaks)
-		     (typep condition 'simple-break))
-	      then (break condition)
-	    elseif ,g-announce
-	      then (format *error-output* "~&Condition type: ~a~%"
-			   (class-of condition))
-		   (format *error-output* "~&Message: ~a~%" condition))
-	   condition)))))
-
-(defmacro test-values (form &optional announce catch-breaks)
-  ;; internal macro
-  (if* *error-protect-tests*
-     then `(test-values-errorset ,form ,announce ,catch-breaks)
-     else `(cons t (multiple-value-list ,form))))
-
-(defmacro test (expected-value test-form
-		&key (test #'eql test-given)
-		     (multiple-values nil multiple-values-given)
-		     (fail-info nil fail-info-given)
-		     (known-failure nil known-failure-given)
-
-;;;;;;;;;; internal, undocumented keywords:
-;;;; Note about these keywords: if they were documented, we'd have a
-;;;; problem, since they break the left-to-right order of evaluation.
-;;;; Specifically, errorset breaks it, and I don't see any way around
-;;;; that.  `errorset' is used by the old test.cl module (eg,
-;;;; test-equal-errorset).
-		     errorset
-		     reported-form
-		     (wanted-message nil wanted-message-given)
-		     (got-message nil got-message-given))
-  "Perform a single test.  `expected-value' is the reference value for the
-test.  `test-form' is a form that will produce the value to be compared to
-the expected-value.  If the values are not the same, then an error is
-logged, otherwise a success is logged.
-
-Normally the comparison of values is done with `eql'.  The `test' keyword
-argument can be used to specify other comparison functions, such as eq,
-equal,equalp, string=, string-equal, etc.
-
-Normally, only the first return value from the test-form is considered,
-however if `multiple-values' is t, then all values returned from test-form
-are considered.
-
-`fail-info' allows more information to be printed with a test failure.
-
-`known-failure' marks the test as a known failure.  This allows for
-programs that do regression analysis on the output from a test run to
-discriminate on new versus known failures."
-  `(test-check
-    :expected-result ,expected-value
-    :test-results
-    (,(if errorset 'test-values-errorset 'test-values) ,test-form t)
-    ,@(when test-given `(:predicate ,test))
-    ,@(when multiple-values-given `(:multiple-values ,multiple-values))
-    ,@(when fail-info-given `(:fail-info ,fail-info))
-    ,@(when known-failure-given `(:known-failure ,known-failure))
-    :test-form ',(if reported-form reported-form test-form)
-    ,@(when wanted-message-given `(:wanted-message ,wanted-message))
-    ,@(when got-message-given `(:got-message ,got-message))))
-
-(defmethod conditionp ((thing condition)) t)
-(defmethod conditionp ((thing t)) nil)
-
-(defmacro test-error (form &key announce
-				catch-breaks
-				(fail-info nil fail-info-given)
-				(known-failure nil known-failure-given)
-				(condition-type ''simple-error)
-				(include-subtypes nil include-subtypes-given)
-				(format-control nil format-control-given)
-				(format-arguments nil format-arguments-given))
-  "Test that `form' signals an error. The order of evaluation of the
-arguments is keywords first, then test form.
-
-If `announce' is non-nil, then cause the error message to be printed.
-
-The `catch-breaks' is non-nil then consider a call to common-lisp:break an
-`error'.
-
-`fail-info' allows more information to be printed with a test failure.
-
-`known-failure' marks the test as a known failure.  This allows for
-programs that do regression analysis on the output from a test run to
-discriminate on new versus known failures.
-
-If `condition-type' is non-nil, it should be a symbol naming a condition
-type, which is used to check against the signalled condition type.  The
-test will fail if they do not match.
-
-`include-subtypes', used with `condition-type', can be used to match a
-condition to an entire subclass of the condition type hierarchy.
-
-`format-control' and `format-arguments' can be used to check the error
-message itself."
-  (let ((g-announce (gensym))
-	(g-catch-breaks (gensym))
-	(g-fail-info (gensym))
-	(g-known-failure (gensym))
-	(g-condition-type (gensym))
-	(g-include-subtypes (gensym))
-	(g-format-control (gensym))
-	(g-format-arguments (gensym))
-	(g-c (gensym)))
-    `(let* ((,g-announce ,announce)
-	    (,g-catch-breaks ,catch-breaks)
-	    ,@(when fail-info-given `((,g-fail-info ,fail-info)))
-	    ,@(when known-failure-given `((,g-known-failure ,known-failure)))
-	    (,g-condition-type ,condition-type)
-	    ,@(when include-subtypes-given
-		`((,g-include-subtypes ,include-subtypes)))
-	    ,@(when format-control-given
-		`((,g-format-control ,format-control)))
-	    ,@(when format-arguments-given
-		`((,g-format-arguments ,format-arguments)))
-	    (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
-       (test-check
-	:predicate #'eq
-	:expected-result t
-	:test-results
-	(test-values (and (conditionp ,g-c)
-			  ,@(if* include-subtypes-given
-			       then `((if* ,g-include-subtypes
-					 then (typep ,g-c ,g-condition-type)
-					 else (eq (class-of ,g-c)
-						  (find-class
-						   ,g-condition-type))))
-			       else `((eq (class-of ,g-c)
-					  (find-class ,g-condition-type))))
-			  ,@(when format-control-given
-			      `((or
-				 (null ,g-format-control)
-				 (string=
-				  (concatenate 'simple-string
-				    "~1@<" ,g-format-control "~:@>")
-				  (simple-condition-format-control ,g-c)))))
-			  ,@(when format-arguments-given
-			      `((or
-				 (null ,g-format-arguments)
-				 (equal
-				  ,g-format-arguments
-				  (simple-condition-format-arguments ,g-c))))))
-		     t)
-	:test-form ',form
-	,@(when fail-info-given `(:fail-info ,g-fail-info))
-	,@(when known-failure-given `(:known-failure ,g-known-failure))
-	:condition-type ,g-condition-type
-	:condition ,g-c
-	,@(when include-subtypes-given
-	    `(:include-subtypes ,g-include-subtypes))
-	,@(when format-control-given
-	    `(:format-control ,g-format-control))
-	,@(when format-arguments-given
-	    `(:format-arguments ,g-format-arguments))))))
-
-(defmacro test-no-error (form &key announce
-				   catch-breaks
-				   (fail-info nil fail-info-given)
-				   (known-failure nil known-failure-given))
-  "Test that `form' does not signal an error.  The order of evaluation of
-the arguments is keywords first, then test form.
-
-If `announce' is non-nil, then cause the error message to be printed.
-
-The `catch-breaks' is non-nil then consider a call to common-lisp:break an
-`error'.
-
-`fail-info' allows more information to be printed with a test failure.
-
-`known-failure' marks the test as a known failure.  This allows for
-programs that do regression analysis on the output from a test run to
-discriminate on new versus known failures."
-  (let ((g-announce (gensym))
-	(g-catch-breaks (gensym))
-	(g-fail-info (gensym))
-	(g-known-failure (gensym))
-	(g-c (gensym)))
-    `(let* ((,g-announce ,announce)
-	    (,g-catch-breaks ,catch-breaks)
-	    ,@(when fail-info-given `((,g-fail-info ,fail-info)))
-	    ,@(when known-failure-given `((,g-known-failure ,known-failure)))
-	    (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
-       (test-check
-	:predicate #'eq
-	:expected-result t
-	:test-results (test-values (not (conditionp ,g-c)))
-	:test-form ',form
-	:condition ,g-c
-	,@(when fail-info-given `(:fail-info ,g-fail-info))
-	,@(when known-failure-given `(:known-failure ,g-known-failure))))))
-
-(defvar *warn-cookie* (cons nil nil))
-
-(defmacro test-warning (form &key fail-info known-failure)
-  "Test that `form' signals a warning.  The order of evaluation of
-the arguments is keywords first, then test form.
-
-`fail-info' allows more information to be printed with a test failure.
-
-`known-failure' marks the test as a known failure.  This allows for
-programs that do regression analysis on the output from a test run to
-discriminate on new versus known failures."
-  (let ((g-fail-info (gensym))
-	(g-known-failure (gensym))
-	(g-value (gensym)))
-    `(let* ((,g-fail-info ,fail-info)
-	    (,g-known-failure ,known-failure)
-	    (,g-value (test-values-errorset ,form nil t)))
-       (test
-	*warn-cookie*
-	(if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
-	   then *warn-cookie*
-	   else ;; test produced no warning
-		nil)
-	:test #'eq
-	:reported-form ,form ;; quoted by test macro
-	:wanted-message "a warning"
-	:got-message "no warning"
-	:fail-info ,g-fail-info
-	:known-failure ,g-known-failure))))
-
-(defmacro test-no-warning (form &key fail-info known-failure)
-  "Test that `form' does not signal a warning.  The order of evaluation of
-the arguments is keywords first, then test form.
-
-`fail-info' allows more information to be printed with a test failure.
-
-`known-failure' marks the test as a known failure.  This allows for
-programs that do regression analysis on the output from a test run to
-discriminate on new versus known failures."
-  (let ((g-fail-info (gensym))
-	(g-known-failure (gensym))
-	(g-value (gensym)))
-    `(let* ((,g-fail-info ,fail-info)
-	    (,g-known-failure ,known-failure)
-	    (,g-value (test-values-errorset ,form nil t)))
-       (test
-	*warn-cookie*
-	(if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
-	   then nil ;; test produced warning
-	   else *warn-cookie*)
-	:test #'eq
-	:reported-form ',form
-	:wanted-message "no warning"
-	:got-message "a warning"
-	:fail-info ,g-fail-info
-	:known-failure ,g-known-failure))))
-
-(defvar *announce-test* nil) ;; if true announce each test that was done
-
-(defmacro errorset (form &optional announce catch-breaks)
-  ;; Evaluate FORM, and if there are no errors and FORM returns
-  ;; values v1,v2,...,vn, then return values t,v1,v2,...,vn.  If an
-  ;; error occurs while evaluating FORM, then return nil immediately.
-  ;; If ANNOUNCE is t, then the error message will be printed out.
-  (if catch-breaks
-      `(handler-case (values-list (cons t (multiple-value-list ,form)))
-         (error (condition)
-           (declare (ignore-if-unused condition))
-           ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
-           nil)
-         (simple-break (condition)
-           (declare (ignore-if-unused condition))
-           ,@(if announce `((format *error-output* "~&Warning: ~a~%" condition))
-)
-           nil))
-    `(handler-case (values-list (cons t (multiple-value-list ,form)))
-       (error (condition)
-         (declare (ignore-if-unused condition))
-         ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
-         nil))))
-
-(defun test-check (&key (predicate #'eql)
-			expected-result test-results test-form
-			multiple-values fail-info known-failure
-			wanted-message got-message condition-type condition
-			include-subtypes format-control format-arguments
-		   &aux fail predicate-failed got wanted)
-  ;; for debugging large/complex test sets:
-  (when *announce-test*
-    (format t "Just did test ~s~%" test-form)
-    (force-output))
-  
-  ;; this is an internal function
-  (flet ((check (expected-result result)
-	   (let* ((results
-		   (multiple-value-list
-		    (errorset (funcall predicate expected-result result) t)))
-		  (failed (null (car results))))
-	     (if* failed
-		then (setq predicate-failed t)
-		     nil
-		else (cadr results)))))
-    (when (conditionp test-results)
-      (setq condition test-results)
-      (setq test-results nil))
-    (when (null (car test-results))
-      (setq fail t))
-    (if* (and (not fail) (not multiple-values))
-       then ;; should be a single result
-	    ;; expected-result is the single result wanted
-	    (when (not (and (cdr test-results)
-			    (check expected-result (cadr test-results))))
-	      (setq fail t))
-	    (when (and (not fail) (cddr test-results))
-	      (setq fail 'single-got-multiple))
-       else ;; multiple results wanted
-	    ;; expected-result is a list of results, each of which
-	    ;; should be checked against the corresponding test-results
-	    ;; using the predicate
-	    (do ((got (cdr test-results) (cdr got))
-		 (want expected-result (cdr want)))
-		((or (null got) (null want))
-		 (when (not (and (null want) (null got)))
-		   (setq fail t)))
-	      (when (not (check (car got) (car want)))
-		(return (setq fail t)))))
-    (if* fail
-       then (when (not known-failure)
-	      (format *error-output*
-		      "~& * * * UNEXPECTED TEST FAILURE * * *~%")
-	      (incf *test-unexpected-failures*))
-	    (format *error-output* "~&Test failed: ~@[known failure: ~*~]~s~%"
-		    known-failure test-form)
-	    (if* (eq 'single-got-multiple fail)
-	       then (format
-		     *error-output*
-		     "~
-Reason: additional value were returned from test form.~%")
-	     elseif predicate-failed
-	       then (format *error-output* "Reason: predicate error.~%")
-	     elseif (null (car test-results))
-	       then (format *error-output* "~
-Reason: an error~@[ (of type `~s')~] was detected.~%"
-			    (when condition (class-of condition)))
-	     elseif condition
-	       then (if* (not (conditionp condition))
-		       then (format *error-output* "~
-Reason: expected but did not detect an error of type `~s'.~%"
-				    condition-type)
-		     elseif (null condition-type)
-		       then (format *error-output* "~
-Reason: detected an unexpected error of type `~s':
-        ~a.~%"
-				    (class-of condition)
-				    condition)
-		     elseif (not (if* include-subtypes
-				    then (typep condition condition-type)
-				    else (eq (class-of condition)
-					     (find-class condition-type))))
-		       then (format *error-output* "~
-Reason: detected an incorrect condition type.~%")
-			    (format *error-output*
-				    "  wanted: ~s~%" condition-type)
-			    (format *error-output*
-				    "     got: ~s~%" (class-of condition))
-		     elseif (and format-control
-				 (not (string=
-				       (setq got
-					 (concatenate 'simple-string
-					   "~1@<" format-control "~:@>"))
-				       (setq wanted
-					 (simple-condition-format-control
-					  condition)))))
-		       then ;; format control doesn't match
-			    (format *error-output* "~
-Reason: the format-control was incorrect.~%")
-			    (format *error-output* "  wanted: ~s~%" wanted)
-			    (format *error-output* "     got: ~s~%" got)
-		     elseif (and format-arguments
-				 (not (equal
-				       (setq got format-arguments)
-				       (setq wanted
-					 (simple-condition-format-arguments
-					  condition)))))
-		       then (format *error-output* "~
-Reason: the format-arguments were incorrect.~%")
-			    (format *error-output* "  wanted: ~s~%" wanted)
-			    (format *error-output* "     got: ~s~%" got)
-		       else ;; what else????
-			    (error "internal-error"))
-	       else (let ((*print-length* 50)
-			  (*print-level* 10))
-		      (if* wanted-message
-			 then (format *error-output*
-				      "  wanted: ~a~%" wanted-message)
-			 else (if* (not multiple-values)
-				 then (format *error-output*
-					      "  wanted: ~s~%"
-					      expected-result)
-				 else (format
-				       *error-output*
-				       "  wanted values: ~{~s~^, ~}~%"
-				       expected-result)))
-		      (if* got-message
-			 then (format *error-output*
-				      "     got: ~a~%" got-message)
-			 else (if* (not multiple-values)
-				 then (format *error-output* "     got: ~s~%"
-				       (second test-results))
-				 else (format
-				       *error-output*
-				       "     got values: ~{~s~^, ~}~%"
-				       (cdr test-results))))))
-	    (when fail-info
-	      (format *error-output* "Additional info: ~a~%" fail-info))
-	    (incf *test-errors*)
-	    (when *break-on-test-failures*
-	      (break "~a is non-nil." '*break-on-test-failures*))
-       else (when known-failure
-	      (format *error-output*
-		      "~&Expected test failure for ~s did not occur.~%"
-		      test-form)
-	      (when fail-info
-		(format *error-output* "Additional info: ~a~%" fail-info))
-	      (setq fail t))
-	    (incf *test-successes*))
-    (not fail)))
-
-(defmacro with-tests ((&key (name "unnamed")) &body body)
-  (let ((g-name (gensym)))
-    `(flet ((doit () ,@body))
-       (let ((,g-name ,name)
-	     (*test-errors* 0)
-	     (*test-successes* 0)
-	     (*test-unexpected-failures* 0))
-	 (format *error-output* "Begin ~a test~%" ,g-name)
-	 (if* *break-on-test-failures*
-	    then (doit)
-	    else (handler-case (doit)
-		   (error (c)
-		     (format
-		      *error-output*
-		      "~
-~&Test ~a aborted by signalling an uncaught error:~%~a~%"
-		      ,g-name c))))
-	 #+allegro
-	 (let ((state (sys:gsgc-switch :print)))
-	   (setf (sys:gsgc-switch :print) nil)
-	   (format t "~&**********************************~%" ,g-name)
-	   (format t "End ~a test~%" ,g-name)
-	   (format t "Errors detected in this test: ~s " *test-errors*)
-	   (unless (zerop *test-unexpected-failures*)
-	     (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
-	   (format t "~%Successes this test:~s~%" *test-successes*)
-	   (setf (sys:gsgc-switch :print) state))
-	 #-allegro
-	 (progn
-	   (format t "~&**********************************~%" ,g-name)
-	   (format t "End ~a test~%" ,g-name)
-	   (format t "Errors detected in this test: ~s " *test-errors*)
-	   (unless (zerop *test-unexpected-failures*)
-	     (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
-	   (format t "~%Successes this test:~s~%" *test-successes*))
-	 ))))
-
-(provide :tester #+module-versions 1.1)
diff --git a/test-suite/old-tests/interactive-test.lisp b/test-suite/old-tests/interactive-test.lisp
deleted file mode 100644
index 420c3ff..0000000
--- a/test-suite/old-tests/interactive-test.lisp
+++ /dev/null
@@ -1,138 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          test-clsql.cl
-;;;; Purpose:       Basic test of CLSQL
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: interactive-test.lisp,v 1.1 2002/09/30 10:19:24 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-
-(defvar *config-pathname* (make-pathname :name "test"
-					 :type "config"
-					 :defaults *load-truename*))
-(defparameter *config* nil)
-
-(defun do-test (&optional (interactive nil))
-  (if interactive
-      (test-interactive)
-    (if (probe-file *config-pathname*)
-	(with-open-file (stream *config-pathname* :direction :input)
-	  (setq *config* (read stream))
-	  (test-automated *config*))
-      (test-interactive))))
-  
-(defun test-interactive ()
-  (do ((done nil))
-      (done)
-    (multiple-value-bind (spec type) (get-spec-and-type)
-      (if spec
-	  (clsql-test-table spec type)
-	  (setq done t)))))
-
-(defun test-automated (config)
-  (dolist (elem config)
-    (let ((type (car elem))
-	  (spec (cadr elem)))
-      #-allegro
-      (unless (eq type :aodbc)
-	(clsql-test-table spec type))
-      #+allegro
-      (clsql-test-table spec type)))
-  )
-
-
-(defun create-test-table (db)
-  (ignore-errors
-    (clsql:execute-command 
-     "DROP TABLE test_clsql" :database db))
-  (clsql:execute-command 
-   "CREATE TABLE test_clsql (n integer, n_pi float, n_pi_str CHAR(20))" 
-   :database db)
-  (dotimes (i 11)
-    (let ((n (- i 5)))
-      (clsql:execute-command
-       (format nil "INSERT INTO test_clsql VALUES (~a,~a,'~a')"
-	       n (clsql:float-to-sql-string (* pi n))
-	       (clsql:float-to-sql-string (* pi n)))
-       :database db))))
-
-(defun drop-test-table (db)
-  (clsql:execute-command "DROP TABLE test_clsql"))
-
-(defun clsql-test-table (spec type)
-  (when (eq type :mysql)
-    (test-clsql-mysql spec))
-  (let ((db (clsql:connect spec :database-type type :if-exists :new)))
-    (unwind-protect
-	(progn
-	  (create-test-table db)
-	  (pprint (clsql:query "select * from test_clsql" 
-			       :database db
-			       :types :auto))
-	  (pprint (clsql:map-query 'vector #'list "select * from test_clsql" 
-				   :database db
-				   :types :auto)) ;;'(:int :double t)))
-	  (drop-test-table db))
-      (clsql:disconnect :database db)))
-  )
-
-(defun test-clsql-mysql (spec)
-  (let ((db (clsql-mysql::database-connect spec :mysql)))
-    (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
-    (clsql-mysql::database-execute-command 
-     "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
-    (dotimes (i 10)
-      (clsql-mysql::database-execute-command
-       (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
-	       i (sqrt i) (format nil "~d" (sqrt i)))
-       db))
-    (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
-      (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
-      (clsql-mysql::database-dump-result-set res db))
-    (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
-    (clsql-mysql::database-disconnect db)))
-
-
-(defun get-spec-and-type ()
-  (format t "~&Test CLSQL")
-  (format t "~&==========~%")
-  (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
-  #+allegro (format t " :aodbc")
-  (format t ") [default END]: ")
-  (let ((type-string (read-line)))
-    (if (zerop (length type-string))
-	(values nil nil)
-	(get-spec-for-type (read-from-string type-string)))))
-
-(defun get-spec-for-type (type)
-  (let ((spec (get-spec-using-format type
-			(ecase type
-			  ((:mysql :postgresql :postgresql-socket)
-			   '("host" "database" "user" "password"))
-			  (:aodbc
-			   '("dsn" "user" "password"))))))
-    (values spec type)))
-
-
-(defun get-spec-using-format (type spec-format)
-  (let (spec)
-    (format t "~&Connection Spec for ~A" (symbol-name type))
-    (format t "~&------------------------------")
-    
-    (dolist (elem spec-format)
-      (format t "~&Enter ~A: " elem)
-      (push (read-line) spec))
-    (nreverse spec)))
diff --git a/test-suite/old-tests/xptest-clsql.lisp b/test-suite/old-tests/xptest-clsql.lisp
deleted file mode 100644
index c301941..0000000
--- a/test-suite/old-tests/xptest-clsql.lisp
+++ /dev/null
@@ -1,224 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          xptest-clsql.cl
-;;;; Purpose:       Test of CLSQL using XPTest package
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: xptest-clsql.lisp,v 1.1 2002/09/30 10:19:24 kevin Exp $
-;;;;
-;;;; The XPTest package can be downloaded from
-;;;; http://alpha.onshored.com/lisp-software/
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-
-;;; This test suite looks for a configuration file named "test.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:
-;;;
-;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
-;;;  (:aodbc ("my-dsn" "a-user" "pass"))
-;;;  (:paostgresql ("localhost" "another-db" "user2" "dont-tell"))
-;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-(mk:load-system "XPTest")
-
-(in-package :clsql-user)
-(use-package :xptest)
-
-(def-test-fixture clsql-fixture ()
-  ((aodbc-spec :accessor aodbc-spec)
-   (mysql-spec :accessor mysql-spec)
-   (pgsql-spec :accessor pgsql-spec)
-   (pgsql-socket-spec :accessor pgsql-socket-spec))
-  (:documentation "Test fixture for CLSQL testing"))
-
-(defvar *config-pathname* (make-pathname :name "test"
-					 :type "config"
-					 :defaults *load-truename*))
-(defmethod setup ((fix clsql-fixture))
-  (if (probe-file *config-pathname*)
-      (let (config)
-	(with-open-file (stream *config-pathname* :direction :input)
-	  (setq config (read stream)))
-	(setf (aodbc-spec fix) (cadr (assoc :aodbc config)))
-	(setf (mysql-spec fix) (cadr (assoc :mysql config)))
-	(setf (pgsql-spec fix) (cadr (assoc :postgresql config)))
-	(setf (pgsql-socket-spec fix) 
-	      (cadr (assoc :postgresql-socket config))))
-      (error "XPTest Config file ~S not found" *config-pathname*)))
-
-(defmethod teardown ((fix clsql-fixture))
-  t)
-
-(defmethod mysql-table-test ((test clsql-fixture))
-  (test-table (mysql-spec test) :mysql))
-
-(defmethod aodbc-table-test ((test clsql-fixture))
-  (test-table (aodbc-spec test) :aodbc))
-
-(defmethod pgsql-table-test ((test clsql-fixture))
-  (test-table (pgsql-spec test) :postgresql))
-
-(defmethod pgsql-socket-table-test ((test clsql-fixture))
-  (test-table (pgsql-socket-spec test) :postgresql-socket))
-
-
-(defmethod test-table (spec type)
-  (when spec
-    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
-      (unwind-protect
-	   (progn
-	     (create-test-table db)
-	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
-	       (test-table-row row :auto))
-	     (dolist (row (query "select * from test_clsql" :database db :types nil))
-	       (test-table-row row nil))
-	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-					     :database db :types :auto)
-		   do (test-table-row row :auto))
-	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-					     :database db :types nil)
-		   do (test-table-row row nil))
-	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
-					 :database db :types nil)
-		   do (test-table-row row nil))
-	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
-					 :database db :types :auto)
-		   do (test-table-row row :auto))
-	     (when (map-query nil #'list "select * from test_clsql" 
-					 :database db :types :auto)
-	       (failure "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))
-	     (do-query ((int float bigint str) "select * from test_clsql" :types :auto)
-	       (test-table-row (list int float bigint str) :auto))
-	     (drop-test-table db)
-	     )
-	(disconnect :database db)))))
-
-
-(defmethod mysql-low-level ((test clsql-fixture))
-  (let ((spec (mysql-spec test)))
-    (when spec
-      (let ((db (clsql-mysql::database-connect spec :mysql)))
-	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
-	(clsql-mysql::database-execute-command 
-	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
-	(dotimes (i 10)
-	  (clsql-mysql::database-execute-command
-	   (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
-		   i (number-to-sql-string (sqrt i))
-		   (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)))
-	  (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
-	    (failure "Error calling mysql-num-rows"))
-	  (clsql-mysql::database-dump-result-set res db))
-	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
-	(clsql-mysql::database-disconnect db)))))
-
-(defparameter clsql-test-suite 
-    (make-test-suite
-     "CLSQL Test Suite"
-     "Basic test suite for database operations."
-     ("MySQL Low Level Interface" 'clsql-fixture
-		   :test-thunk 'mysql-low-level
-		   :description "A test of MySQL low-level interface")
-     ("MySQL Table" 'clsql-fixture
-		   :test-thunk 'mysql-table-test
-		   :description "A test of MySQL")
-     ("PostgreSQL Table" 'clsql-fixture
-		   :test-thunk 'pgsql-table-test
-		   :description "A test of PostgreSQL tables")     
-     ("PostgreSQL Socket Table" 'clsql-fixture
-		   :test-thunk 'pgsql-socket-table-test
-		   :description "A test of PostgreSQL Socket tables")
-  ))
-
-#+allegro 
-(add-test (make-test-case "AODBC table test" 'clsql-fixture
-			  :test-thunk 'aodbc-table-test
-			  :description "Test AODBC table")
-	  clsql-test-suite)
-
-;;;; Testing functions
-
-(defun transform-float-1 (i)
-  (* i (abs (/ i 2)) (expt 10 (* 2 i))))
-
-(defun transform-bigint-1 (i)
-  (* i (expt 10 (* 3 (abs i)))))
-
-(defun create-test-table (db)
-  (ignore-errors
-    (clsql:execute-command 
-     "DROP TABLE test_clsql" :database db))
-  (clsql:execute-command 
-   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" 
-   :database db)
-  (dotimes (i 11)
-    (let* ((test-int (- i 5))
-	   (test-flt (transform-float-1 test-int)))
-      (clsql:execute-command
-       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
-	       test-int
-	       (number-to-sql-string test-flt)
-	       (transform-bigint-1 test-int)
-	       (number-to-sql-string test-flt)
-	       )
-       :database db))))
-
-(defun parse-double (num-str)
-  (let ((*read-default-float-format* 'double-float))
-    (coerce (read-from-string num-str) 'double-float)))
-
-(defun test-table-row (row types)
-  (unless (and (listp row)
-	       (= 4 (length row)))
-    (failure "Row ~S is incorrect format" row))
-  (destructuring-bind (int float bigint str) row
-    (cond
-      ((eq types :auto)
-       (unless (and (integerp int)
-		    (typep float 'double-float)
-		    (integerp bigint)
-		    (stringp str))
-	 (failure "Incorrect field type for row ~S" row)))
-       ((null types)
-	(unless (and (stringp int)
-		     (stringp float)
-		     (stringp bigint)
-		     (stringp str))
-	  (failure "Incorrect field type for row ~S" row))
-	(setq int (parse-integer int))
-	(setq bigint (parse-integer bigint))
-	(setq float (parse-double float)))
-       ((listp types)
-	(error "NYI")
-	)
-       (t 
-	(failure "Invalid types field (~S) passed to test-table-row" types)))
-    (unless (= float (transform-float-1 int))
-      (failure "Wrong float value ~A for int ~A (row ~S)" float int row))
-    (unless (= float (parse-double str))
-      (failure "Wrong string value ~A" str))))
-
-
-(defun drop-test-table (db)
-  (clsql:execute-command "DROP TABLE test_clsql"))
-
-(report-result (run-test clsql-test-suite :handle-errors nil) :verbose t)
-
-
diff --git a/test-suite/tester-clsql.lisp b/test-suite/tester-clsql.lisp
deleted file mode 100644
index 4959580..0000000
--- a/test-suite/tester-clsql.lisp
+++ /dev/null
@@ -1,238 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          tester-clsql.cl
-;;;; Purpose:       Automated test of CLSQL using ACL's tester
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: tester-clsql.lisp,v 1.2 2002/10/16 11:51:04 kevin Exp $
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; 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.
-;;;; *************************************************************************
-
-;;; This test suite looks for a configuration file named "test.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:
-;;;
-;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
-;;;  (:aodbc ("my-dsn" "a-user" "pass"))
-;;;  (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
-;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
-
-
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :cl-user)
-
-(unless (find-package :util.test)
-  (load (make-pathname :name "acl-compat-tester" :defaults *load-truename*)))
-
-(in-package :clsql-user)
-(use-package :util.test)
-
-(defvar *config-pathname* (make-pathname :name "test"
-					 :type "config"
-					 :defaults *load-truename*))
-
-(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))
-  (:documentation "Test fixture for CLSQL testing"))
-
-
-(defun read-specs (&optional (path *config-pathname*))
-  (if (probe-file path)
-      (with-open-file (stream path :direction :input)
-	(let ((config (read stream))
-	      (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) 
-		(cadr (assoc :postgresql-socket config)))
-	  specs))
-      (error "CLSQL tester config file ~S not found" path)))
-
-(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 test-table (spec type)
-  (when spec
-    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
-      (unwind-protect
-	   (progn
-	     (create-test-table db)
-	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
-	       (test-table-row row :auto type))
-	     (dolist (row (query "select * from test_clsql" :database db :types nil))
-	       (test-table-row row nil type))
-	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
-					     :database db :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)
-		   do (test-table-row row nil type))
-	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
-					 :database db :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)
-		 do (test-table-row row :auto type))
-	     (test (map-query nil #'list "select * from test_clsql" 
-			      :database db :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)
-	       (test-table-row (list int float bigint str) :auto type))
-	     (drop-test-table db)
-	     )
-	(disconnect :database db)))))
-
-
-(defmethod mysql-low-level ((test conn-specs))
-  (let ((spec (mysql-spec test)))
-    (when spec
-      (let ((db (clsql-mysql::database-connect spec :mysql)))
-	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
-	(clsql-mysql::database-execute-command 
-	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" 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)))
-	   db))
-	(let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
-	  (test (mysql:mysql-num-rows
-		 (clsql-mysql::mysql-result-set-res-ptr res))
-		10
-		:test #'eql
-		:fail-info "Error calling mysql-num-rows")
-	  (clsql-mysql::database-dump-result-set res db))
-	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
-	(clsql-mysql::database-disconnect db)))))
-
-
-
-;;;; Testing functions
-
-(defun transform-float-1 (i)
-  (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
-
-(defun transform-bigint-1 (i)
-  (* i (expt 10 (* 3 (abs i)))))
-
-(defun create-test-table (db)
-  (ignore-errors
-    (clsql:execute-command 
-     "DROP TABLE test_clsql" :database db))
-  (clsql:execute-command 
-   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" 
-   :database db)
-  (dotimes (i 11)
-    (let* ((test-int (- i 5))
-	   (test-flt (transform-float-1 test-int)))
-      (clsql:execute-command
-       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
-	       test-int
-	       (number-to-sql-string test-flt)
-	       (transform-bigint-1 test-int)
-	       (number-to-sql-string test-flt)
-	       )
-       :database db))))
-
-(defun parse-double (num-str)
-  (let ((*read-default-float-format* 'double-float))
-    (coerce (read-from-string num-str) 'double-float)))
-
-(defun test-table-row (row types db-type)
-  (test (and (listp row)
-	     (= 4 (length row)))
-	t
-	:fail-info 
-	(format nil "Row ~S is incorrect format" row))
-  (destructuring-bind (int float bigint str) row
-    (cond
-      ((eq types :auto)
-       (test (and (integerp int)
-		  (typep float 'double-float)
-		  (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions
-		      (integerp bigint)) 
-		  (stringp str))
-	     t
-	     :fail-info 
-	     (format nil "Incorrect field type for row ~S (types :auto)" row)))
-       ((null types)
-	(test (and (stringp int)
-		     (stringp float)
-		     (stringp bigint)
-		     (stringp str))
-	      t
-	      :fail-info 
-	      (format nil "Incorrect field type for row ~S (types nil)" row))
-	(setq int (parse-integer int))
-	(setq bigint (parse-integer bigint))
-	(setq float (parse-double float)))
-       ((listp types)
-	(error "NYI")
-	)
-       (t 
-	(test t nil
-	      :fail-info
-	      (format nil "Invalid types field (~S) passed to test-table-row" types))))
-    (test (transform-float-1 int)
-	  float
-	  :test #'eql
-	  :fail-info 
-	  (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))
-    (test float
-	  (parse-double str)
-	  :test #'double-float-equal
-	  :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S"
-			     str float row))))
-
-
-(defun double-float-equal (a b)
-  (if (zerop a)
-      (if (zerop b)
-	  t
-	  nil)
-      (let ((diff (abs (/ (- a b) a))))
-	(if (> diff (* 10 double-float-epsilon))
-	    nil
-	    t))))
-	 
-(defun drop-test-table (db)
-  (clsql:execute-command "DROP TABLE test_clsql" :database db))
-
-(defun do-test ()
-    (let ((specs (read-specs)))
-      (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)
-      )))
-
-
-(do-test)
diff --git a/tests/README b/tests/README
new file mode 100644
index 0000000..a344c4b
--- /dev/null
+++ b/tests/README
@@ -0,0 +1,16 @@
+These tests require the setup of a configuration file with account
+information for MySQL and PostgreSQL SQL servers. Additionally,
+the Debian package acl-installer must be installed and a license downloaded
+to use the AODBC tests.
+
+This test suite looks for a configuration file named ".clsql-test.config"
+located in the users home directory.
+
+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 file might look like this:
+
+((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
+ (:aodbc ("my-dsn" "a-user" "pass"))
+ (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
+ (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
diff --git a/tests/acl-compat-tester.lisp b/tests/acl-compat-tester.lisp
new file mode 100644
index 0000000..e90adc5
--- /dev/null
+++ b/tests/acl-compat-tester.lisp
@@ -0,0 +1,600 @@
+;; tester.cl
+;; A test harness for Allegro CL.
+;;
+;; copyright (c) 1985-1986 Franz Inc, Alameda, CA
+;; copyright (c) 1986-2001 Franz Inc, Berkeley, CA - All rights reserved.
+;;
+;; This code is free software; you can redistribute it and/or
+;; modify it under the terms of the version 2.1 of
+;; the GNU Lesser General Public License as published by 
+;; the Free Software Foundation, as clarified by the Franz
+;; preamble to the LGPL found in
+;; http://opensource.franz.com/preamble.html.
+;;
+;; This code is distributed in the hope that it will be useful,
+;; but without any warranty; without even the implied warranty of
+;; merchantability or fitness for a particular purpose.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; Version 2.1 of the GNU Lesser General Public License can be
+;; found at http://opensource.franz.com/license.html.
+;; If it is not present, you can access it from
+;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer
+;; version) or write to the Free Software Foundation, Inc., 59 Temple
+;; Place, Suite 330, Boston, MA  02111-1307  USA
+;;
+;;;; from the original ACL 6.1 sources:
+;; $Id: acl-compat-tester.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $
+
+
+(defpackage :util.test
+  (:use :common-lisp)
+  (:shadow #:test)
+  (:export
+;;;; Control variables:
+   #:*break-on-test-failures*
+   #:*error-protect-tests*
+   #:*test-errors*
+   #:*test-successes*
+   #:*test-unexpected-failures*
+
+;;;; The test macros:
+   #:test
+   #:test-error
+   #:test-no-error
+   #:test-warning
+   #:test-no-warning
+   
+   #:with-tests
+   ))
+
+(in-package :util.test)
+
+#+cmu
+(unless (find-class 'break nil)
+  (define-condition break (simple-condition) ()))
+
+(define-condition simple-break (error simple-condition) ())
+
+;; the if* macro used in Allegro:
+;;
+;; This is in the public domain... please feel free to put this definition
+;; in your code or distribute it with your version of lisp.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
+
+(defmacro if* (&rest args)
+   (do ((xx (reverse args) (cdr xx))
+	(state :init)
+	(elseseen nil)
+	(totalcol nil)
+	(lookat nil nil)
+	(col nil))
+       ((null xx)
+	(cond ((eq state :compl)
+	       `(cond ,@totalcol))
+	      (t (error "if*: illegal form ~s" args))))
+       (cond ((and (symbolp (car xx))
+		   (member (symbol-name (car xx))
+			   if*-keyword-list
+			   :test #'string-equal))
+	      (setq lookat (symbol-name (car xx)))))
+
+       (cond ((eq state :init)
+	      (cond (lookat (cond ((string-equal lookat "thenret")
+				   (setq col nil
+					 state :then))
+				  (t (error
+				      "if*: bad keyword ~a" lookat))))
+		    (t (setq state :col
+			     col nil)
+		       (push (car xx) col))))
+	     ((eq state :col)
+	      (cond (lookat
+		     (cond ((string-equal lookat "else")
+			    (cond (elseseen
+				   (error
+				    "if*: multiples elses")))
+			    (setq elseseen t)
+			    (setq state :init)
+			    (push `(t ,@col) totalcol))
+			   ((string-equal lookat "then")
+			    (setq state :then))
+			   (t (error "if*: bad keyword ~s"
+					      lookat))))
+		    (t (push (car xx) col))))
+	     ((eq state :then)
+	      (cond (lookat
+		     (error
+		      "if*: keyword ~s at the wrong place " (car xx)))
+		    (t (setq state :compl)
+		       (push `(,(car xx) ,@col) totalcol))))
+	     ((eq state :compl)
+	      (cond ((not (string-equal lookat "elseif"))
+		     (error "if*: missing elseif clause ")))
+	      (setq state :init)))))
+
+
+
+
+(defvar *break-on-test-failures* nil
+  "When a test failure occurs, common-lisp:break is called, allowing
+interactive debugging of the failure.")
+
+(defvar *test-errors* 0
+  "The value is the number of test errors which have occurred.")
+(defvar *test-successes* 0
+  "The value is the number of test successes which have occurred.")
+(defvar *test-unexpected-failures* 0
+  "The value is the number of unexpected test failures which have occurred.")
+
+(defvar *error-protect-tests* nil
+  "Protect each test from errors.  If an error occurs, then that will be
+taken as a test failure unless test-error is being used.")
+
+(defmacro test-values-errorset (form &optional announce catch-breaks)
+  ;; internal macro
+  (let ((g-announce (gensym))
+	(g-catch-breaks (gensym)))
+    `(let* ((,g-announce ,announce)
+	    (,g-catch-breaks ,catch-breaks))
+       (handler-case (cons t (multiple-value-list ,form))
+	 (condition (condition)
+	   (if* (and (null ,g-catch-breaks)
+		     (typep condition 'simple-break))
+	      then (break condition)
+	    elseif ,g-announce
+	      then (format *error-output* "~&Condition type: ~a~%"
+			   (class-of condition))
+		   (format *error-output* "~&Message: ~a~%" condition))
+	   condition)))))
+
+(defmacro test-values (form &optional announce catch-breaks)
+  ;; internal macro
+  (if* *error-protect-tests*
+     then `(test-values-errorset ,form ,announce ,catch-breaks)
+     else `(cons t (multiple-value-list ,form))))
+
+(defmacro test (expected-value test-form
+		&key (test #'eql test-given)
+		     (multiple-values nil multiple-values-given)
+		     (fail-info nil fail-info-given)
+		     (known-failure nil known-failure-given)
+
+;;;;;;;;;; internal, undocumented keywords:
+;;;; Note about these keywords: if they were documented, we'd have a
+;;;; problem, since they break the left-to-right order of evaluation.
+;;;; Specifically, errorset breaks it, and I don't see any way around
+;;;; that.  `errorset' is used by the old test.cl module (eg,
+;;;; test-equal-errorset).
+		     errorset
+		     reported-form
+		     (wanted-message nil wanted-message-given)
+		     (got-message nil got-message-given))
+  "Perform a single test.  `expected-value' is the reference value for the
+test.  `test-form' is a form that will produce the value to be compared to
+the expected-value.  If the values are not the same, then an error is
+logged, otherwise a success is logged.
+
+Normally the comparison of values is done with `eql'.  The `test' keyword
+argument can be used to specify other comparison functions, such as eq,
+equal,equalp, string=, string-equal, etc.
+
+Normally, only the first return value from the test-form is considered,
+however if `multiple-values' is t, then all values returned from test-form
+are considered.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure.  This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+  `(test-check
+    :expected-result ,expected-value
+    :test-results
+    (,(if errorset 'test-values-errorset 'test-values) ,test-form t)
+    ,@(when test-given `(:predicate ,test))
+    ,@(when multiple-values-given `(:multiple-values ,multiple-values))
+    ,@(when fail-info-given `(:fail-info ,fail-info))
+    ,@(when known-failure-given `(:known-failure ,known-failure))
+    :test-form ',(if reported-form reported-form test-form)
+    ,@(when wanted-message-given `(:wanted-message ,wanted-message))
+    ,@(when got-message-given `(:got-message ,got-message))))
+
+(defmethod conditionp ((thing condition)) t)
+(defmethod conditionp ((thing t)) nil)
+
+(defmacro test-error (form &key announce
+				catch-breaks
+				(fail-info nil fail-info-given)
+				(known-failure nil known-failure-given)
+				(condition-type ''simple-error)
+				(include-subtypes nil include-subtypes-given)
+				(format-control nil format-control-given)
+				(format-arguments nil format-arguments-given))
+  "Test that `form' signals an error. The order of evaluation of the
+arguments is keywords first, then test form.
+
+If `announce' is non-nil, then cause the error message to be printed.
+
+The `catch-breaks' is non-nil then consider a call to common-lisp:break an
+`error'.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure.  This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures.
+
+If `condition-type' is non-nil, it should be a symbol naming a condition
+type, which is used to check against the signalled condition type.  The
+test will fail if they do not match.
+
+`include-subtypes', used with `condition-type', can be used to match a
+condition to an entire subclass of the condition type hierarchy.
+
+`format-control' and `format-arguments' can be used to check the error
+message itself."
+  (let ((g-announce (gensym))
+	(g-catch-breaks (gensym))
+	(g-fail-info (gensym))
+	(g-known-failure (gensym))
+	(g-condition-type (gensym))
+	(g-include-subtypes (gensym))
+	(g-format-control (gensym))
+	(g-format-arguments (gensym))
+	(g-c (gensym)))
+    `(let* ((,g-announce ,announce)
+	    (,g-catch-breaks ,catch-breaks)
+	    ,@(when fail-info-given `((,g-fail-info ,fail-info)))
+	    ,@(when known-failure-given `((,g-known-failure ,known-failure)))
+	    (,g-condition-type ,condition-type)
+	    ,@(when include-subtypes-given
+		`((,g-include-subtypes ,include-subtypes)))
+	    ,@(when format-control-given
+		`((,g-format-control ,format-control)))
+	    ,@(when format-arguments-given
+		`((,g-format-arguments ,format-arguments)))
+	    (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
+       (test-check
+	:predicate #'eq
+	:expected-result t
+	:test-results
+	(test-values (and (conditionp ,g-c)
+			  ,@(if* include-subtypes-given
+			       then `((if* ,g-include-subtypes
+					 then (typep ,g-c ,g-condition-type)
+					 else (eq (class-of ,g-c)
+						  (find-class
+						   ,g-condition-type))))
+			       else `((eq (class-of ,g-c)
+					  (find-class ,g-condition-type))))
+			  ,@(when format-control-given
+			      `((or
+				 (null ,g-format-control)
+				 (string=
+				  (concatenate 'simple-string
+				    "~1@<" ,g-format-control "~:@>")
+				  (simple-condition-format-control ,g-c)))))
+			  ,@(when format-arguments-given
+			      `((or
+				 (null ,g-format-arguments)
+				 (equal
+				  ,g-format-arguments
+				  (simple-condition-format-arguments ,g-c))))))
+		     t)
+	:test-form ',form
+	,@(when fail-info-given `(:fail-info ,g-fail-info))
+	,@(when known-failure-given `(:known-failure ,g-known-failure))
+	:condition-type ,g-condition-type
+	:condition ,g-c
+	,@(when include-subtypes-given
+	    `(:include-subtypes ,g-include-subtypes))
+	,@(when format-control-given
+	    `(:format-control ,g-format-control))
+	,@(when format-arguments-given
+	    `(:format-arguments ,g-format-arguments))))))
+
+(defmacro test-no-error (form &key announce
+				   catch-breaks
+				   (fail-info nil fail-info-given)
+				   (known-failure nil known-failure-given))
+  "Test that `form' does not signal an error.  The order of evaluation of
+the arguments is keywords first, then test form.
+
+If `announce' is non-nil, then cause the error message to be printed.
+
+The `catch-breaks' is non-nil then consider a call to common-lisp:break an
+`error'.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure.  This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+  (let ((g-announce (gensym))
+	(g-catch-breaks (gensym))
+	(g-fail-info (gensym))
+	(g-known-failure (gensym))
+	(g-c (gensym)))
+    `(let* ((,g-announce ,announce)
+	    (,g-catch-breaks ,catch-breaks)
+	    ,@(when fail-info-given `((,g-fail-info ,fail-info)))
+	    ,@(when known-failure-given `((,g-known-failure ,known-failure)))
+	    (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
+       (test-check
+	:predicate #'eq
+	:expected-result t
+	:test-results (test-values (not (conditionp ,g-c)))
+	:test-form ',form
+	:condition ,g-c
+	,@(when fail-info-given `(:fail-info ,g-fail-info))
+	,@(when known-failure-given `(:known-failure ,g-known-failure))))))
+
+(defvar *warn-cookie* (cons nil nil))
+
+(defmacro test-warning (form &key fail-info known-failure)
+  "Test that `form' signals a warning.  The order of evaluation of
+the arguments is keywords first, then test form.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure.  This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+  (let ((g-fail-info (gensym))
+	(g-known-failure (gensym))
+	(g-value (gensym)))
+    `(let* ((,g-fail-info ,fail-info)
+	    (,g-known-failure ,known-failure)
+	    (,g-value (test-values-errorset ,form nil t)))
+       (test
+	*warn-cookie*
+	(if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
+	   then *warn-cookie*
+	   else ;; test produced no warning
+		nil)
+	:test #'eq
+	:reported-form ,form ;; quoted by test macro
+	:wanted-message "a warning"
+	:got-message "no warning"
+	:fail-info ,g-fail-info
+	:known-failure ,g-known-failure))))
+
+(defmacro test-no-warning (form &key fail-info known-failure)
+  "Test that `form' does not signal a warning.  The order of evaluation of
+the arguments is keywords first, then test form.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure.  This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+  (let ((g-fail-info (gensym))
+	(g-known-failure (gensym))
+	(g-value (gensym)))
+    `(let* ((,g-fail-info ,fail-info)
+	    (,g-known-failure ,known-failure)
+	    (,g-value (test-values-errorset ,form nil t)))
+       (test
+	*warn-cookie*
+	(if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
+	   then nil ;; test produced warning
+	   else *warn-cookie*)
+	:test #'eq
+	:reported-form ',form
+	:wanted-message "no warning"
+	:got-message "a warning"
+	:fail-info ,g-fail-info
+	:known-failure ,g-known-failure))))
+
+(defvar *announce-test* nil) ;; if true announce each test that was done
+
+(defmacro errorset (form &optional announce catch-breaks)
+  ;; Evaluate FORM, and if there are no errors and FORM returns
+  ;; values v1,v2,...,vn, then return values t,v1,v2,...,vn.  If an
+  ;; error occurs while evaluating FORM, then return nil immediately.
+  ;; If ANNOUNCE is t, then the error message will be printed out.
+  (if catch-breaks
+      `(handler-case (values-list (cons t (multiple-value-list ,form)))
+         (error (condition)
+           (declare (ignorable condition))
+           ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
+           nil)
+         (simple-break (condition)
+           (declare (ignorable condition))
+           ,@(if announce `((format *error-output* "~&Warning: ~a~%" condition))
+)
+           nil))
+    `(handler-case (values-list (cons t (multiple-value-list ,form)))
+       (error (condition)
+         (declare (ignorable condition))
+         ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
+         nil))))
+
+(defun test-check (&key (predicate #'eql)
+			expected-result test-results test-form
+			multiple-values fail-info known-failure
+			wanted-message got-message condition-type condition
+			include-subtypes format-control format-arguments
+		   &aux fail predicate-failed got wanted)
+  ;; for debugging large/complex test sets:
+  (when *announce-test*
+    (format t "Just did test ~s~%" test-form)
+    (force-output))
+  
+  ;; this is an internal function
+  (flet ((check (expected-result result)
+	   (let* ((results
+		   (multiple-value-list
+		    (errorset (funcall predicate expected-result result) t)))
+		  (failed (null (car results))))
+	     (if* failed
+		then (setq predicate-failed t)
+		     nil
+		else (cadr results)))))
+    (when (conditionp test-results)
+      (setq condition test-results)
+      (setq test-results nil))
+    (when (null (car test-results))
+      (setq fail t))
+    (if* (and (not fail) (not multiple-values))
+       then ;; should be a single result
+	    ;; expected-result is the single result wanted
+	    (when (not (and (cdr test-results)
+			    (check expected-result (cadr test-results))))
+	      (setq fail t))
+	    (when (and (not fail) (cddr test-results))
+	      (setq fail 'single-got-multiple))
+       else ;; multiple results wanted
+	    ;; expected-result is a list of results, each of which
+	    ;; should be checked against the corresponding test-results
+	    ;; using the predicate
+	    (do ((got (cdr test-results) (cdr got))
+		 (want expected-result (cdr want)))
+		((or (null got) (null want))
+		 (when (not (and (null want) (null got)))
+		   (setq fail t)))
+	      (when (not (check (car got) (car want)))
+		(return (setq fail t)))))
+    (if* fail
+       then (when (not known-failure)
+	      (format *error-output*
+		      "~& * * * UNEXPECTED TEST FAILURE * * *~%")
+	      (incf *test-unexpected-failures*))
+	    (format *error-output* "~&Test failed: ~@[known failure: ~*~]~s~%"
+		    known-failure test-form)
+	    (if* (eq 'single-got-multiple fail)
+	       then (format
+		     *error-output*
+		     "~
+Reason: additional value were returned from test form.~%")
+	     elseif predicate-failed
+	       then (format *error-output* "Reason: predicate error.~%")
+	     elseif (null (car test-results))
+	       then (format *error-output* "~
+Reason: an error~@[ (of type `~s')~] was detected.~%"
+			    (when condition (class-of condition)))
+	     elseif condition
+	       then (if* (not (conditionp condition))
+		       then (format *error-output* "~
+Reason: expected but did not detect an error of type `~s'.~%"
+				    condition-type)
+		     elseif (null condition-type)
+		       then (format *error-output* "~
+Reason: detected an unexpected error of type `~s':
+        ~a.~%"
+				    (class-of condition)
+				    condition)
+		     elseif (not (if* include-subtypes
+				    then (typep condition condition-type)
+				    else (eq (class-of condition)
+					     (find-class condition-type))))
+		       then (format *error-output* "~
+Reason: detected an incorrect condition type.~%")
+			    (format *error-output*
+				    "  wanted: ~s~%" condition-type)
+			    (format *error-output*
+				    "     got: ~s~%" (class-of condition))
+		     elseif (and format-control
+				 (not (string=
+				       (setq got
+					 (concatenate 'simple-string
+					   "~1@<" format-control "~:@>"))
+				       (setq wanted
+					 (simple-condition-format-control
+					  condition)))))
+		       then ;; format control doesn't match
+			    (format *error-output* "~
+Reason: the format-control was incorrect.~%")
+			    (format *error-output* "  wanted: ~s~%" wanted)
+			    (format *error-output* "     got: ~s~%" got)
+		     elseif (and format-arguments
+				 (not (equal
+				       (setq got format-arguments)
+				       (setq wanted
+					 (simple-condition-format-arguments
+					  condition)))))
+		       then (format *error-output* "~
+Reason: the format-arguments were incorrect.~%")
+			    (format *error-output* "  wanted: ~s~%" wanted)
+			    (format *error-output* "     got: ~s~%" got)
+		       else ;; what else????
+			    (error "internal-error"))
+	       else (let ((*print-length* 50)
+			  (*print-level* 10))
+		      (if* wanted-message
+			 then (format *error-output*
+				      "  wanted: ~a~%" wanted-message)
+			 else (if* (not multiple-values)
+				 then (format *error-output*
+					      "  wanted: ~s~%"
+					      expected-result)
+				 else (format
+				       *error-output*
+				       "  wanted values: ~{~s~^, ~}~%"
+				       expected-result)))
+		      (if* got-message
+			 then (format *error-output*
+				      "     got: ~a~%" got-message)
+			 else (if* (not multiple-values)
+				 then (format *error-output* "     got: ~s~%"
+				       (second test-results))
+				 else (format
+				       *error-output*
+				       "     got values: ~{~s~^, ~}~%"
+				       (cdr test-results))))))
+	    (when fail-info
+	      (format *error-output* "Additional info: ~a~%" fail-info))
+	    (incf *test-errors*)
+	    (when *break-on-test-failures*
+	      (break "~a is non-nil." '*break-on-test-failures*))
+       else (when known-failure
+	      (format *error-output*
+		      "~&Expected test failure for ~s did not occur.~%"
+		      test-form)
+	      (when fail-info
+		(format *error-output* "Additional info: ~a~%" fail-info))
+	      (setq fail t))
+	    (incf *test-successes*))
+    (not fail)))
+
+(defmacro with-tests ((&key (name "unnamed")) &body body)
+  (let ((g-name (gensym)))
+    `(flet ((doit () ,@body))
+       (let ((,g-name ,name)
+	     (*test-errors* 0)
+	     (*test-successes* 0)
+	     (*test-unexpected-failures* 0))
+	 (format *error-output* "Begin ~a test~%" ,g-name)
+	 (if* *break-on-test-failures*
+	    then (doit)
+	    else (handler-case (doit)
+		   (error (c)
+		     (format
+		      *error-output*
+		      "~
+~&Test ~a aborted by signalling an uncaught error:~%~a~%"
+		      ,g-name c))))
+	 #+allegro
+	 (let ((state (sys:gsgc-switch :print)))
+	   (setf (sys:gsgc-switch :print) nil)
+	   (format t "~&**********************************~%" ,g-name)
+	   (format t "End ~a test~%" ,g-name)
+	   (format t "Errors detected in this test: ~s " *test-errors*)
+	   (unless (zerop *test-unexpected-failures*)
+	     (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
+	   (format t "~%Successes this test:~s~%" *test-successes*)
+	   (setf (sys:gsgc-switch :print) state))
+	 #-allegro
+	 (progn
+	   (format t "~&**********************************~%" ,g-name)
+	   (format t "End ~a test~%" ,g-name)
+	   (format t "Errors detected in this test: ~s " *test-errors*)
+	   (unless (zerop *test-unexpected-failures*)
+	     (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
+	   (format t "~%Successes this test:~s~%" *test-successes*))
+	 ))))
+
+(provide :tester #+module-versions 1.1)
diff --git a/tests/old-tests/xptest-clsql.lisp b/tests/old-tests/xptest-clsql.lisp
new file mode 100644
index 0000000..c37e49a
--- /dev/null
+++ b/tests/old-tests/xptest-clsql.lisp
@@ -0,0 +1,224 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          xptest-clsql.cl
+;;;; Purpose:       Test of CLSQL using XPTest package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: xptest-clsql.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $
+;;;;
+;;;; The XPTest package can be downloaded from
+;;;; http://alpha.onshored.com/lisp-software/
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+
+;;; This test suite looks for a configuration file named "test.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:
+;;;
+;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
+;;;  (:aodbc ("my-dsn" "a-user" "pass"))
+;;;  (:paostgresql ("localhost" "another-db" "user2" "dont-tell"))
+;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+(mk:load-system "XPTest")
+
+(in-package :clsql-user)
+(use-package :xptest)
+
+(def-test-fixture clsql-fixture ()
+  ((aodbc-spec :accessor aodbc-spec)
+   (mysql-spec :accessor mysql-spec)
+   (pgsql-spec :accessor pgsql-spec)
+   (pgsql-socket-spec :accessor pgsql-socket-spec))
+  (:documentation "Test fixture for CLSQL testing"))
+
+(defvar *config-pathname* (make-pathname :name "test"
+					 :type "config"
+					 :defaults *load-truename*))
+(defmethod setup ((fix clsql-fixture))
+  (if (probe-file *config-pathname*)
+      (let (config)
+	(with-open-file (stream *config-pathname* :direction :input)
+	  (setq config (read stream)))
+	(setf (aodbc-spec fix) (cadr (assoc :aodbc config)))
+	(setf (mysql-spec fix) (cadr (assoc :mysql config)))
+	(setf (pgsql-spec fix) (cadr (assoc :postgresql config)))
+	(setf (pgsql-socket-spec fix) 
+	      (cadr (assoc :postgresql-socket config))))
+      (error "XPTest Config file ~S not found" *config-pathname*)))
+
+(defmethod teardown ((fix clsql-fixture))
+  t)
+
+(defmethod mysql-table-test ((test clsql-fixture))
+  (test-table (mysql-spec test) :mysql))
+
+(defmethod aodbc-table-test ((test clsql-fixture))
+  (test-table (aodbc-spec test) :aodbc))
+
+(defmethod pgsql-table-test ((test clsql-fixture))
+  (test-table (pgsql-spec test) :postgresql))
+
+(defmethod pgsql-socket-table-test ((test clsql-fixture))
+  (test-table (pgsql-socket-spec test) :postgresql-socket))
+
+
+(defmethod test-table (spec type)
+  (when spec
+    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
+      (unwind-protect
+	   (progn
+	     (create-test-table db)
+	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
+	       (test-table-row row :auto))
+	     (dolist (row (query "select * from test_clsql" :database db :types nil))
+	       (test-table-row row nil))
+	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
+					     :database db :types :auto)
+		   do (test-table-row row :auto))
+	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
+					     :database db :types nil)
+		   do (test-table-row row nil))
+	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
+					 :database db :types nil)
+		   do (test-table-row row nil))
+	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
+					 :database db :types :auto)
+		   do (test-table-row row :auto))
+	     (when (map-query nil #'list "select * from test_clsql" 
+					 :database db :types :auto)
+	       (failure "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))
+	     (do-query ((int float bigint str) "select * from test_clsql" :types :auto)
+	       (test-table-row (list int float bigint str) :auto))
+	     (drop-test-table db)
+	     )
+	(disconnect :database db)))))
+
+
+(defmethod mysql-low-level ((test clsql-fixture))
+  (let ((spec (mysql-spec test)))
+    (when spec
+      (let ((db (clsql-mysql::database-connect spec :mysql)))
+	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
+	(clsql-mysql::database-execute-command 
+	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
+	(dotimes (i 10)
+	  (clsql-mysql::database-execute-command
+	   (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
+		   i (number-to-sql-string (sqrt i))
+		   (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)))
+	  (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
+	    (failure "Error calling mysql-num-rows"))
+	  (clsql-mysql::database-dump-result-set res db))
+	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
+	(clsql-mysql::database-disconnect db)))))
+
+(defparameter clsql-test-suite 
+    (make-test-suite
+     "CLSQL Test Suite"
+     "Basic test suite for database operations."
+     ("MySQL Low Level Interface" 'clsql-fixture
+		   :test-thunk 'mysql-low-level
+		   :description "A test of MySQL low-level interface")
+     ("MySQL Table" 'clsql-fixture
+		   :test-thunk 'mysql-table-test
+		   :description "A test of MySQL")
+     ("PostgreSQL Table" 'clsql-fixture
+		   :test-thunk 'pgsql-table-test
+		   :description "A test of PostgreSQL tables")     
+     ("PostgreSQL Socket Table" 'clsql-fixture
+		   :test-thunk 'pgsql-socket-table-test
+		   :description "A test of PostgreSQL Socket tables")
+  ))
+
+#+allegro 
+(add-test (make-test-case "AODBC table test" 'clsql-fixture
+			  :test-thunk 'aodbc-table-test
+			  :description "Test AODBC table")
+	  clsql-test-suite)
+
+;;;; Testing functions
+
+(defun transform-float-1 (i)
+  (* i (abs (/ i 2)) (expt 10 (* 2 i))))
+
+(defun transform-bigint-1 (i)
+  (* i (expt 10 (* 3 (abs i)))))
+
+(defun create-test-table (db)
+  (ignore-errors
+    (clsql:execute-command 
+     "DROP TABLE test_clsql" :database db))
+  (clsql:execute-command 
+   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" 
+   :database db)
+  (dotimes (i 11)
+    (let* ((test-int (- i 5))
+	   (test-flt (transform-float-1 test-int)))
+      (clsql:execute-command
+       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
+	       test-int
+	       (number-to-sql-string test-flt)
+	       (transform-bigint-1 test-int)
+	       (number-to-sql-string test-flt)
+	       )
+       :database db))))
+
+(defun parse-double (num-str)
+  (let ((*read-default-float-format* 'double-float))
+    (coerce (read-from-string num-str) 'double-float)))
+
+(defun test-table-row (row types)
+  (unless (and (listp row)
+	       (= 4 (length row)))
+    (failure "Row ~S is incorrect format" row))
+  (destructuring-bind (int float bigint str) row
+    (cond
+      ((eq types :auto)
+       (unless (and (integerp int)
+		    (typep float 'double-float)
+		    (integerp bigint)
+		    (stringp str))
+	 (failure "Incorrect field type for row ~S" row)))
+       ((null types)
+	(unless (and (stringp int)
+		     (stringp float)
+		     (stringp bigint)
+		     (stringp str))
+	  (failure "Incorrect field type for row ~S" row))
+	(setq int (parse-integer int))
+	(setq bigint (parse-integer bigint))
+	(setq float (parse-double float)))
+       ((listp types)
+	(error "NYI")
+	)
+       (t 
+	(failure "Invalid types field (~S) passed to test-table-row" types)))
+    (unless (= float (transform-float-1 int))
+      (failure "Wrong float value ~A for int ~A (row ~S)" float int row))
+    (unless (= float (parse-double str))
+      (failure "Wrong string value ~A" str))))
+
+
+(defun drop-test-table (db)
+  (clsql:execute-command "DROP TABLE test_clsql"))
+
+(report-result (run-test clsql-test-suite :handle-errors nil) :verbose t)
+
+
diff --git a/tests/package.lisp b/tests/package.lisp
new file mode 100644
index 0000000..fef952d
--- /dev/null
+++ b/tests/package.lisp
@@ -0,0 +1,20 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          package.lisp
+;;;; Purpose:       Package file clsql testing suite
+;;;; Author:        Kevin M. Rosenberg
+;;;; Date Started:  Apr 2003
+;;;;
+;;;; $Id: package.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $
+;;;; *************************************************************************
+
+(defpackage #:clsql-tests
+  (:use #:asdf #:cl #:clsql #:rtest #:util.test))
+
+(in-package #:clsql-tests)
+
+(setf *catch-errors* nil)
+
+(rem-all-tests)
diff --git a/tests/rt.lisp b/tests/rt.lisp
new file mode 100644
index 0000000..d4dd2ae
--- /dev/null
+++ b/tests/rt.lisp
@@ -0,0 +1,254 @@
+#|----------------------------------------------------------------------------|
+ | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
+ |                                                                            |
+ | Permission  to  use,  copy, modify, and distribute this software  and  its |
+ | documentation for any purpose  and without fee is hereby granted, provided |
+ | that this copyright  and  permission  notice  appear  in  all  copies  and |
+ | supporting  documentation,  and  that  the  name  of M.I.T. not be used in |
+ | advertising or  publicity  pertaining  to  distribution  of  the  software |
+ | without   specific,   written   prior   permission.      M.I.T.  makes  no |
+ | representations  about  the  suitability of this software for any purpose. |
+ | It is provided "as is" without express or implied warranty.                |
+ |                                                                            |
+ |  M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,  INCLUDING  |
+ |  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL  |
+ |  M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL  DAMAGES  OR  |
+ |  ANY  DAMAGES  WHATSOEVER  RESULTING  FROM  LOSS OF USE, DATA OR PROFITS,  |
+ |  WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER  TORTIOUS  ACTION,  |
+ |  ARISING  OUT  OF  OR  IN  CONNECTION WITH THE USE OR PERFORMANCE OF THIS  |
+ |  SOFTWARE.                                                                 |
+ |----------------------------------------------------------------------------|#
+
+(defpackage #:regression-test
+  (:nicknames #:rtest #-lispworks #:rt) 
+  (:use #:cl)
+  (:export #:*do-tests-when-defined* #:*test* #:continue-testing
+	   #:deftest #:do-test #:do-tests #:get-test #:pending-tests
+	   #:rem-all-tests #:rem-test)
+  (:documentation "The MIT regression tester with pfdietz's modifications"))
+
+(in-package :regression-test)
+
+(defvar *test* nil "Current test name")
+(defvar *do-tests-when-defined* nil)
+(defvar *entries* '(nil) "Test database")
+(defvar *in-test* nil "Used by TEST")
+(defvar *debug* nil "For debugging")
+(defvar *catch-errors* t
+  "When true, causes errors in a test to be caught.")
+(defvar *print-circle-on-failure* nil
+  "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
+(defvar *compile-tests* nil
+  "When true, compile the tests before running them.")
+(defvar *optimization-settings* '((safety 3)))
+(defvar *expected-failures* nil
+  "A list of test names that are expected to fail.")
+
+(defstruct (entry (:conc-name nil)
+		  (:type list))
+  pend name form)
+
+(defmacro vals (entry) `(cdddr ,entry))
+
+(defmacro defn (entry) `(cdr ,entry))
+
+(defun pending-tests ()
+  (do ((l (cdr *entries*) (cdr l))
+       (r nil))
+      ((null l) (nreverse r))
+    (when (pend (car l))
+      (push (name (car l)) r))))
+
+(defun rem-all-tests ()
+  (setq *entries* (list nil))
+  nil)
+
+(defun rem-test (&optional (name *test*))
+  (do ((l *entries* (cdr l)))
+      ((null (cdr l)) nil)
+    (when (equal (name (cadr l)) name)
+      (setf (cdr l) (cddr l))
+      (return name))))
+
+(defun get-test (&optional (name *test*))
+  (defn (get-entry name)))
+
+(defun get-entry (name)
+  (let ((entry (find name (cdr *entries*)
+		     :key #'name
+		     :test #'equal)))
+    (when (null entry)
+      (report-error t
+        "~%No test with name ~:@(~S~)."
+	name))
+    entry))
+
+(defmacro deftest (name form &rest values)
+  `(add-entry '(t ,name ,form .,values)))
+
+(defun add-entry (entry)
+  (setq entry (copy-list entry))
+  (do ((l *entries* (cdr l))) (nil)
+    (when (null (cdr l))
+      (setf (cdr l) (list entry))
+      (return nil))
+    (when (equal (name (cadr l)) 
+		 (name entry))
+      (setf (cadr l) entry)
+      (report-error nil
+        "Redefining test ~:@(~S~)"
+        (name entry))
+      (return nil)))
+  (when *do-tests-when-defined*
+    (do-entry entry))
+  (setq *test* (name entry)))
+
+(defun report-error (error? &rest args)
+  (cond (*debug* 
+	 (apply #'format t args)
+	 (if error? (throw '*debug* nil)))
+	(error? (apply #'error args))
+	(t (apply #'warn args))))
+
+(defun do-test (&optional (name *test*))
+  (do-entry (get-entry name)))
+
+(defun equalp-with-case (x y)
+  "Like EQUALP, but doesn't do case conversion of characters."
+  (cond
+   ((eq x y) t)
+   ((consp x)
+    (and (consp y)
+	 (equalp-with-case (car x) (car y))
+	 (equalp-with-case (cdr x) (cdr y))))
+   ((and (typep x 'array)
+	 (= (array-rank x) 0))
+    (equalp-with-case (aref x) (aref y)))
+   ((typep x 'vector)
+    (and (typep y 'vector)
+	 (let ((x-len (length x))
+	       (y-len (length y)))
+	   (and (eql x-len y-len)
+		(loop
+		 for e1 across x
+		 for e2 across y
+		 always (equalp-with-case e1 e2))))))
+   ((and (typep x 'array)
+	 (typep y 'array)
+	 (not (equal (array-dimensions x)
+		     (array-dimensions y))))
+    nil)
+   ((typep x 'array)
+    (and (typep y 'array)
+	 (let ((size (array-total-size x)))
+	   (loop for i from 0 below size
+		 always (equalp-with-case (row-major-aref x i)
+					  (row-major-aref y i))))))
+   (t (eql x y))))
+
+(defun do-entry (entry &optional
+		       (s *standard-output*))
+  (catch '*in-test*
+    (setq *test* (name entry))
+    (setf (pend entry) t)
+    (let* ((*in-test* t)
+	   ;; (*break-on-warnings* t)
+	   (aborted nil)
+	   r)
+      ;; (declare (special *break-on-warnings*))
+
+      (block aborted
+	(setf r
+	      (flet ((%do
+		      ()
+		      (if *compile-tests*
+			  (multiple-value-list
+			   (funcall (compile
+				     nil
+				     `(lambda ()
+					(declare
+					 (optimize ,@*optimization-settings*))
+					,(form entry)))))
+			(multiple-value-list
+			 (eval (form entry))))))
+		(if *catch-errors*
+		    (handler-bind
+			((style-warning #'muffle-warning)
+			 (error #'(lambda (c)
+				    (setf aborted t)
+				    (setf r (list c))
+				    (return-from aborted nil))))
+		      (%do))
+		  (%do)))))
+
+      (setf (pend entry)
+	    (or aborted
+		(not (equalp-with-case r (vals entry)))))
+      
+      (when (pend entry)
+	(let ((*print-circle* *print-circle-on-failure*))
+	  (format s "~&Test ~:@(~S~) failed~
+                   ~%Form: ~S~
+                   ~%Expected value~P: ~
+                      ~{~S~^~%~17t~}~%"
+		  *test* (form entry)
+		  (length (vals entry))
+		  (vals entry))
+	  (format s "Actual value~P: ~
+                      ~{~S~^~%~15t~}.~%"
+		  (length r) r)))))
+  (when (not (pend entry)) *test*))
+
+(defun continue-testing ()
+  (if *in-test*
+      (throw '*in-test* nil)
+      (do-entries *standard-output*)))
+
+(defun do-tests (&optional
+		 (out *standard-output*))
+  (dolist (entry (cdr *entries*))
+    (setf (pend entry) t))
+  (if (streamp out)
+      (do-entries out)
+      (with-open-file 
+	  (stream out :direction :output)
+	(do-entries stream))))
+
+(defun do-entries (s)
+  (format s "~&Doing ~A pending test~:P ~
+             of ~A tests total.~%"
+          (count t (cdr *entries*)
+		 :key #'pend)
+	  (length (cdr *entries*)))
+  (dolist (entry (cdr *entries*))
+    (when (pend entry)
+      (format s "~@[~<~%~:; ~:@(~S~)~>~]"
+	      (do-entry entry s))))
+  (let ((pending (pending-tests))
+	(expected-table (make-hash-table :test #'equal)))
+    (dolist (ex *expected-failures*)
+      (setf (gethash ex expected-table) t))
+    (let ((new-failures
+	   (loop for pend in pending
+		 unless (gethash pend expected-table)
+		 collect pend)))
+      (if (null pending)
+	  (format s "~&No tests failed.")
+	(progn
+	  (format s "~&~A out of ~A ~
+                   total tests failed: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+		  (length pending)
+		  (length (cdr *entries*))
+		  pending)
+	  (if (null new-failures)
+	      (format s "~&No unexpected failures.")
+	    (when *expected-failures*
+	      (format s "~&~A unexpected failures: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+		    (length new-failures)
+		    new-failures)))
+	  ))
+      (null pending))))
diff --git a/tests/tables.lisp b/tests/tables.lisp
new file mode 100644
index 0000000..92ff34f
--- /dev/null
+++ b/tests/tables.lisp
@@ -0,0 +1,262 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          tables.cl
+;;;; Purpose:       Table creation tests in CLSQL
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: tables.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+;;; This test suite looks for a configuration file named ".clsql-test.config"
+;;; located in the users home directory.
+;;;
+;;; 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:
+;;;
+;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
+;;;  (:aodbc ("my-dsn" "a-user" "pass"))
+;;;  (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
+;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
+
+(in-package :clsql-tests)
+
+(defvar *config-pathname*
+  (make-pathname :default (user-homedir-pathname)
+		 :name ".clsql-test"
+		 :type ".config"))
+
+(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))
+  (:documentation "Test fixture for CLSQL testing"))
+
+
+(defun read-specs (&optional (path *config-pathname*))
+  (if (probe-file path)
+      (with-open-file (stream path :direction :input)
+	(let ((config (read stream))
+	      (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) 
+		(cadr (assoc :postgresql-socket config)))
+	  specs))
+      (error "CLSQL tester config file ~S not found" path)))
+
+(defvar *conn-specs* (read-specs))
+
+(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 test-table (spec type)
+  (when spec
+    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
+      (unwind-protect
+	   (progn
+	     (create-test-table db)
+	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
+	       (test-table-row row :auto type))
+	     (dolist (row (query "select * from test_clsql" :database db :types nil))
+	       (test-table-row row nil type))
+	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
+					     :database db :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)
+		   do (test-table-row row nil type))
+	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
+					 :database db :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)
+		 do (test-table-row row :auto type))
+	     (test (map-query nil #'list "select * from test_clsql" 
+			      :database db :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)
+	       (test-table-row (list int float bigint str) :auto type))
+	     (drop-test-table db)
+	     )
+	(disconnect :database db)))))
+
+
+;;;; Testing functions
+
+(defun transform-float-1 (i)
+  (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
+
+(defun transform-bigint-1 (i)
+  (* i (expt 10 (* 3 (abs i)))))
+
+(defun create-test-table (db)
+  (ignore-errors
+    (clsql:execute-command 
+     "DROP TABLE test_clsql" :database db))
+  (clsql:execute-command 
+   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" 
+   :database db)
+  (dotimes (i 11)
+    (let* ((test-int (- i 5))
+	   (test-flt (transform-float-1 test-int)))
+      (clsql:execute-command
+       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
+	       test-int
+	       (number-to-sql-string test-flt)
+	       (transform-bigint-1 test-int)
+	       (number-to-sql-string test-flt)
+	       )
+       :database db))))
+
+(defun parse-double (num-str)
+  (let ((*read-default-float-format* 'double-float))
+    (coerce (read-from-string num-str) 'double-float)))
+
+(defun test-table-row (row types db-type)
+  (test (and (listp row)
+	     (= 4 (length row)))
+	t
+	:fail-info 
+	(format nil "Row ~S is incorrect format" row))
+  (destructuring-bind (int float bigint str) row
+    (cond
+      ((eq types :auto)
+       (test (and (integerp int)
+		  (typep float 'double-float)
+		  (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions
+		      (integerp bigint)) 
+		  (stringp str))
+	     t
+	     :fail-info 
+	     (format nil "Incorrect field type for row ~S (types :auto)" row)))
+       ((null types)
+	(test (and (stringp int)
+		     (stringp float)
+		     (stringp bigint)
+		     (stringp str))
+	      t
+	      :fail-info 
+	      (format nil "Incorrect field type for row ~S (types nil)" row))
+	(setq int (parse-integer int))
+	(setq bigint (parse-integer bigint))
+	(setq float (parse-double float)))
+       ((listp types)
+	(error "NYI")
+	)
+       (t 
+	(test t nil
+	      :fail-info
+	      (format nil "Invalid types field (~S) passed to test-table-row" types))))
+    (test (transform-float-1 int)
+	  float
+	  :test #'eql
+	  :fail-info 
+	  (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))
+    (test float
+	  (parse-double str)
+	  :test #'double-float-equal
+	  :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S"
+			     str float row))))
+
+
+(defun double-float-equal (a b)
+  (if (zerop a)
+      (if (zerop b)
+	  t
+	  nil)
+      (let ((diff (abs (/ (- a b) a))))
+	(if (> diff (* 10 double-float-epsilon))
+	    nil
+	    t))))
+	 
+(defun drop-test-table (db)
+  (clsql:execute-command "DROP TABLE test_clsql" :database db))
+
+
+(deftest lowlevel.mysql.table.1
+  (let ((spec (mysql-spec *conn-specs*))
+	(result))
+    (when spec
+      (let ((db (clsql-mysql::database-connect spec :mysql)))
+	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
+	(clsql-mysql::database-execute-command 
+	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" 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)))
+	   db))
+	(let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
+	  (setq result (mysql:mysql-num-rows
+			(clsql-mysql::mysql-result-set-res-ptr res)))
+	  (clsql-mysql::database-dump-result-set res db))
+	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
+	(clsql-mysql::database-disconnect db))))
+  10)
+
+;(mysql-table-test specs)
+;(pgsql-table-test specs)
+;(pgsql-socket-table-test specs)
+;(aodbc-table-test specs)
+
+
+
+(defmacro def-test-table (name spec type)
+  (deftest ,name
+      (when ,spec
+	(let ((db (clsql:connect ,spec :database-type ,type :if-exists :new)))
+	  (unwind-protect
+	   (progn
+	     (create-test-table db)
+	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
+	       (test-table-row row :auto type))
+	     (dolist (row (query "select * from test_clsql" :database db :types nil))
+	       (test-table-row row nil type))
+	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
+					     :database db :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)
+		   do (test-table-row row nil type))
+	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
+					 :database db :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)
+		 do (test-table-row row :auto type))
+	     (test (map-query nil #'list "select * from test_clsql" 
+			      :database db :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)
+	       (test-table-row (list int float bigint str) :auto type))
+	     (drop-test-table db)
+	     )
+	(disconnect :database db)))))
diff --git a/tests/tests.lisp b/tests/tests.lisp
new file mode 100644
index 0000000..415fa2f
--- /dev/null
+++ b/tests/tests.lisp
@@ -0,0 +1,234 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          tests.lisp
+;;;; Purpose:       Automated test of CLSQL using ACL's tester
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: tests.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; 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.
+;;;; *************************************************************************
+
+;;; This test suite looks for a configuration file named ".clsql-test.config"
+;;; located in the users home directory.
+;;;
+;;; 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:
+;;;
+;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
+;;;  (:aodbc ("my-dsn" "a-user" "pass"))
+;;;  (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
+;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
+
+(in-package :clsql-tests)
+
+(defvar *config-pathname*
+  (make-pathname :defaults (user-homedir-pathname)
+		 :name ".clsql-test"
+		 :type "config"))
+
+
+(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))
+  (:documentation "Test fixture for CLSQL testing"))
+
+
+(defun read-specs (&optional (path *config-pathname*))
+  (if (probe-file path)
+      (with-open-file (stream path :direction :input)
+	(let ((config (read stream))
+	      (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) 
+		(cadr (assoc :postgresql-socket config)))
+	  specs))
+      (error "CLSQL tester config file ~S not found" path)))
+
+(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 test-table (spec type)
+  (when spec
+    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
+      (unwind-protect
+	   (progn
+	     (create-test-table db)
+	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
+	       (test-table-row row :auto type))
+	     (dolist (row (query "select * from test_clsql" :database db :types nil))
+	       (test-table-row row nil type))
+	     (loop for row across (map-query 'vector #'list "select * from test_clsql" 
+					     :database db :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)
+		   do (test-table-row row nil type))
+	     (loop for row in (map-query 'list #'list "select * from test_clsql" 
+					 :database db :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)
+		 do (test-table-row row :auto type))
+	     (test (map-query nil #'list "select * from test_clsql" 
+			      :database db :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)
+	       (test-table-row (list int float bigint str) :auto type))
+	     (drop-test-table db)
+	     )
+	(disconnect :database db)))))
+
+
+(defmethod mysql-low-level ((test conn-specs))
+  (let ((spec (mysql-spec test)))
+    (when spec
+      (let ((db (clsql-mysql::database-connect spec :mysql)))
+	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
+	(clsql-mysql::database-execute-command 
+	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" 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)))
+	   db))
+	(let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
+	  (test (mysql:mysql-num-rows
+		 (clsql-mysql::mysql-result-set-res-ptr res))
+		10
+		:test #'eql
+		:fail-info "Error calling mysql-num-rows")
+	  (clsql-mysql::database-dump-result-set res db))
+	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
+	(clsql-mysql::database-disconnect db)))))
+
+
+
+;;;; Testing functions
+
+(defun transform-float-1 (i)
+  (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
+
+(defun transform-bigint-1 (i)
+  (* i (expt 10 (* 3 (abs i)))))
+
+(defun create-test-table (db)
+  (ignore-errors
+    (clsql:execute-command 
+     "DROP TABLE test_clsql" :database db))
+  (clsql:execute-command 
+   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" 
+   :database db)
+  (dotimes (i 11)
+    (let* ((test-int (- i 5))
+	   (test-flt (transform-float-1 test-int)))
+      (clsql:execute-command
+       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
+	       test-int
+	       (number-to-sql-string test-flt)
+	       (transform-bigint-1 test-int)
+	       (number-to-sql-string test-flt)
+	       )
+       :database db))))
+
+(defun parse-double (num-str)
+  (let ((*read-default-float-format* 'double-float))
+    (coerce (read-from-string num-str) 'double-float)))
+
+(defun test-table-row (row types db-type)
+  (test (and (listp row)
+	     (= 4 (length row)))
+	t
+	:fail-info 
+	(format nil "Row ~S is incorrect format" row))
+  (destructuring-bind (int float bigint str) row
+    (cond
+      ((eq types :auto)
+       (test (and (integerp int)
+		  (typep float 'double-float)
+		  (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions
+		      (integerp bigint)) 
+		  (stringp str))
+	     t
+	     :fail-info 
+	     (format nil "Incorrect field type for row ~S (types :auto)" row)))
+       ((null types)
+	(test (and (stringp int)
+		     (stringp float)
+		     (stringp bigint)
+		     (stringp str))
+	      t
+	      :fail-info 
+	      (format nil "Incorrect field type for row ~S (types nil)" row))
+	(setq int (parse-integer int))
+	(setq bigint (parse-integer bigint))
+	(setq float (parse-double float)))
+       ((listp types)
+	(error "NYI")
+	)
+       (t 
+	(test t nil
+	      :fail-info
+	      (format nil "Invalid types field (~S) passed to test-table-row" types))))
+    (test (transform-float-1 int)
+	  float
+	  :test #'eql
+	  :fail-info 
+	  (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))
+    (test float
+	  (parse-double str)
+	  :test #'double-float-equal
+	  :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S"
+			     str float row))))
+
+
+(defun double-float-equal (a b)
+  (if (zerop a)
+      (if (zerop b)
+	  t
+	  nil)
+      (let ((diff (abs (/ (- a b) a))))
+	(if (> diff (* 10 double-float-epsilon))
+	    nil
+	    t))))
+	 
+(defun drop-test-table (db)
+  (clsql:execute-command "DROP TABLE test_clsql" :database db))
+
+(defun do-test ()
+    (let ((specs (read-specs)))
+      (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)
+      )))
+
+
+(do-test)