From 41b3ac652c94d50d2028fefd08d35ac5311eb085 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 27 Mar 2002 09:03:47 +0000 Subject: [PATCH] r1676: *** empty log message *** --- ChangeLog | 3 + Makefile | 4 +- test-suite/.cvsignore | 1 + test-clsql.cl => test-suite/test-clsql.cl | 12 ++- test-suite/xptest-clsql.cl | 98 +++++++++++++++++++++++ 5 files changed, 109 insertions(+), 9 deletions(-) create mode 100755 test-suite/.cvsignore rename test-clsql.cl => test-suite/test-clsql.cl (92%) create mode 100644 test-suite/xptest-clsql.cl diff --git a/ChangeLog b/ChangeLog index 84a0766..2bbd921 100644 --- a/ChangeLog +++ b/ChangeLog @@ -15,6 +15,9 @@ * test-clsql.cl: Updated to test postgresql-socket's read-double-from-socket function. + * test-suite/xptest-clsql.cl + Start testing using XPTest package + 25 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) * interfaces/mysql/mysql-api.cl: Added mysql-fetch-fields, diff --git a/Makefile b/Makefile index 2494826..1448463 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ # Programer: Kevin M. Rosenberg # Date Started: Mar 2002 # -# CVS Id: $Id: Makefile,v 1.3 2002/03/27 08:16:24 kevin Exp $ +# CVS Id: $Id: Makefile,v 1.4 2002/03/27 09:03:47 kevin Exp $ # # This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg # @@ -36,7 +36,7 @@ VERSION=$(shell cat VERSION) DISTDIR=$(PACKAGE)-$(VERSION) DIST_TARBALL=$(DISTDIR).tar.gz DIST_ZIP=$(DISTDIR).zip -SOURCE_FILES=interfaces sql cmucl-compat doc Makefile VERSION \ +SOURCE_FILES=interfaces sql cmucl-compat doc test-suite Makefile VERSION \ COPYING.CLSQL COPYING.MaiSQL README INSTALL ChangeLog NEWS TODO \ set-logical.cl test-clsql.cl \ clsql.system clsql-aodbc.system clsql-mysql.system \ diff --git a/test-suite/.cvsignore b/test-suite/.cvsignore new file mode 100755 index 0000000..102a86f --- /dev/null +++ b/test-suite/.cvsignore @@ -0,0 +1 @@ +test.config diff --git a/test-clsql.cl b/test-suite/test-clsql.cl similarity index 92% rename from test-clsql.cl rename to test-suite/test-clsql.cl index 316c1ae..7c57ae7 100644 --- a/test-clsql.cl +++ b/test-suite/test-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: test-clsql.cl,v 1.10 2002/03/27 05:04:19 kevin Exp $ +;;;; $Id: test-clsql.cl,v 1.1 2002/03/27 09:00:15 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -53,22 +53,20 @@ (clsql-test-table spec type))) ) -(defun make-test-float (i) - (* i (expt 10 (* i 4)))) (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, flt float, flt_str CHAR(20))" + "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:number-to-sql-string (make-test-float n)) - (clsql:number-to-sql-string (make-test-float n))) + n (clsql:float-to-sql-string (* pi n)) + (clsql:float-to-sql-string (* pi n))) :database db)))) (defun drop-test-table (db) @@ -83,7 +81,7 @@ (create-test-table db) (pprint (clsql:query "select * from test_clsql" :database db - :types nil)) + :types :auto)) (pprint (clsql:map-query 'vector #'list "select * from test_clsql" :database db :types :auto)) ;;'(:int :double t))) diff --git a/test-suite/xptest-clsql.cl b/test-suite/xptest-clsql.cl new file mode 100644 index 0000000..5e070a9 --- /dev/null +++ b/test-suite/xptest-clsql.cl @@ -0,0 +1,98 @@ +;;;; -*- 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.cl,v 1.1 2002/03/27 09:00:15 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) +(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) + (postgresql-spec :accessor postgresql-spec) + (postgresql-socket-spec :accessor postgresql-socket-spec)) + (:documentation "Test fixture for CLSQL testing")) + +(defvar *config-pathname* (make-pathname :name "test-clsql" + :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 (postgresql-spec fix) (cadr (assoc :postgresql config))) + (setf (postgresql-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-test ((test clsql-fixture)) + (let ((spec (mysql-spec test))) + (when spec + (let ((db (clsql:connect spec :database-type :mysql + :if-exists :new))) + (unwind-protect + (progn + (create-test-table db) + (pprint (query "select * from test_clsql" + :database db + :types :auto)) + (pprint (map-query 'vector #'list "select * from test_clsql" + :database db + :types :auto)) + (drop-test-table db) + ) + (disconnect :database db)))))) + +(defparameter clsql-test-suite + (make-test-suite + "CLSQL Test Suite" + "Basic test suite for database operations." + ("MySQL Test" 'clsql-fixture + :test-thunk 'mysql-test + :description "A test of MySQL"))) + +(report-result (run-test clsql-test-suite) :verbose t) + + +;;;; Testing functions + +(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")) -- 2.34.1