From c1a4d6ce4083a3e5db3872c3ed6b46d15a59698c Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 24 Mar 2002 18:31:05 +0000 Subject: [PATCH] r1651: *** empty log message *** --- .cvsignore | 1 + ChangeLog | 3 + VERSION | 2 +- interfaces/postgresql/postgresql-sql.cl | 4 +- test-clsql.cl | 93 +++++++++++++++---------- 5 files changed, 63 insertions(+), 40 deletions(-) diff --git a/.cvsignore b/.cvsignore index d7ab7d9..2949e34 100755 --- a/.cvsignore +++ b/.cvsignore @@ -1,3 +1,4 @@ *.zip *.tar.gz copy +test-clsql.config diff --git a/ChangeLog b/ChangeLog index e8086df..823debd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -5,6 +5,9 @@ to utilize field types, yet. * Changed postgresql-socket result set from cons to a structure + + * Updated test-clsql.cl to use automated testing with a config + file 23 Mar 2002 Kevin Rosenberg (kevin@rosenberg.net) diff --git a/VERSION b/VERSION index aa34b8b..4f6c765 100644 --- a/VERSION +++ b/VERSION @@ -1,2 +1,2 @@ -0.5.1 +0.5.2-pre diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl index 6dedf46..805f2c3 100644 --- a/interfaces/postgresql/postgresql-sql.cl +++ b/interfaces/postgresql/postgresql-sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-sql.cl,v 1.3 2002/03/24 18:08:27 kevin Exp $ +;;;; $Id: postgresql-sql.cl,v 1.4 2002/03/24 18:31:05 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -161,7 +161,7 @@ (PQresultErrorMessage result))))) (PQclear result)))))) -(defstruct postgresql-result-sset +(defstruct postgresql-result-set (res-ptr (uffi:make-null-pointer 'pgsql-result) :type pgsql-result-def) (field-types nil :type cons) diff --git a/test-clsql.cl b/test-clsql.cl index 2f1d960..9cc2929 100644 --- a/test-clsql.cl +++ b/test-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: test-clsql.cl,v 1.2 2002/03/24 04:01:26 kevin Exp $ +;;;; $Id: test-clsql.cl,v 1.3 2002/03/24 18:31:05 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -20,38 +20,36 @@ (in-package :cl-user) -(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))))) +(defvar *config-pathname* (make-pathname :name "test-clsql" + :type "config" + :defaults *load-truename*)) +(defparameter *config* nil) -(defun get-spec-for-type (type) - (let ((spec (get-spec type - (ecase type - ((:mysql :postgresql :postgresql-socket) - '("host" "database" "user" "password")) - (:aodbc - '("dsn" "user" "password")))))) - (values spec type))))) +(defun do-test () + (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))) + (clsql-test-table spec type)))) -(defun get-spec (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))) -(defun test-clsql (spec type) + +(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))) @@ -82,19 +80,40 @@ (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 t))) + (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :field-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))) -#-non-interactive-test -(do ((done nil)) - (done) - (multiple-value-bind (spec type) (get-spec-and-type) - (if spec - (test-clsql spec type) - (setq done t)))) +(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))) -- 2.34.1