From: Kevin M. Rosenberg Date: Wed, 27 Mar 2002 09:03:47 +0000 (+0000) Subject: r1676: *** empty log message *** X-Git-Tag: v3.8.6~1200 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=41b3ac652c94d50d2028fefd08d35ac5311eb085 r1676: *** empty log message *** --- 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-clsql.cl b/test-clsql.cl deleted file mode 100644 index 316c1ae..0000000 --- a/test-clsql.cl +++ /dev/null @@ -1,140 +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: test-clsql.cl,v 1.10 2002/03/27 05:04:19 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-clsql" - :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 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))" - :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))) - :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 nil)) - (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/.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-suite/test-clsql.cl b/test-suite/test-clsql.cl new file mode 100644 index 0000000..7c57ae7 --- /dev/null +++ b/test-suite/test-clsql.cl @@ -0,0 +1,138 @@ +;;;; -*- 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: 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 +;;;; +;;;; 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-clsql" + :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/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"))