X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=test-clsql.cl;h=9cc29299dd21c7dfc8e79154157b1917c39230b6;hb=d9e609eddd22c1f837d9b030ebc15b0f40ddf5f0;hp=2f1d960caef5e4347e2ffdd9a3299bb6ebc51b12;hpb=9a78eef71c902d3b272fb7c777bff6dd0acd8a2b;p=clsql.git 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)))