1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: test-clsql.cl
6 ;;;; Purpose: Basic test of CLSQL
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
10 ;;;; $Id: test-clsql.cl,v 1.10 2002/03/27 05:04:19 kevin Exp $
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; CLSQL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
23 (defvar *config-pathname* (make-pathname :name "test-clsql"
25 :defaults *load-truename*))
26 (defparameter *config* nil)
28 (defun do-test (&optional (interactive nil))
31 (if (probe-file *config-pathname*)
32 (with-open-file (stream *config-pathname* :direction :input)
33 (setq *config* (read stream))
34 (test-automated *config*))
37 (defun test-interactive ()
40 (multiple-value-bind (spec type) (get-spec-and-type)
42 (clsql-test-table spec type)
45 (defun test-automated (config)
47 (let ((type (car elem))
50 (unless (eq type :aodbc)
51 (clsql-test-table spec type))
53 (clsql-test-table spec type)))
56 (defun make-test-float (i)
57 (* i (expt 10 (* i 4))))
59 (defun create-test-table (db)
61 (clsql:execute-command
62 "DROP TABLE test_clsql" :database db))
63 (clsql:execute-command
64 "CREATE TABLE test_clsql (n integer, flt float, flt_str CHAR(20))"
68 (clsql:execute-command
69 (format nil "INSERT INTO test_clsql VALUES (~a,~a,'~a')"
70 n (clsql:number-to-sql-string (make-test-float n))
71 (clsql:number-to-sql-string (make-test-float n)))
74 (defun drop-test-table (db)
75 (clsql:execute-command "DROP TABLE test_clsql"))
77 (defun clsql-test-table (spec type)
78 (when (eq type :mysql)
79 (test-clsql-mysql spec))
80 (let ((db (clsql:connect spec :database-type type :if-exists :new)))
83 (create-test-table db)
84 (pprint (clsql:query "select * from test_clsql"
87 (pprint (clsql:map-query 'vector #'list "select * from test_clsql"
89 :types :auto)) ;;'(:int :double t)))
91 (clsql:disconnect :database db)))
94 (defun test-clsql-mysql (spec)
95 (let ((db (clsql-mysql::database-connect spec :mysql)))
96 (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
97 (clsql-mysql::database-execute-command
98 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
100 (clsql-mysql::database-execute-command
101 (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
102 i (sqrt i) (format nil "~d" (sqrt i)))
104 (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
105 (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
106 (clsql-mysql::database-dump-result-set res db))
107 (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
108 (clsql-mysql::database-disconnect db)))
111 (defun get-spec-and-type ()
112 (format t "~&Test CLSQL")
113 (format t "~&==========~%")
114 (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
115 #+allegro (format t " :aodbc")
116 (format t ") [default END]: ")
117 (let ((type-string (read-line)))
118 (if (zerop (length type-string))
120 (get-spec-for-type (read-from-string type-string)))))
122 (defun get-spec-for-type (type)
123 (let ((spec (get-spec-using-format type
125 ((:mysql :postgresql :postgresql-socket)
126 '("host" "database" "user" "password"))
128 '("dsn" "user" "password"))))))
132 (defun get-spec-using-format (type spec-format)
134 (format t "~&Connection Spec for ~A" (symbol-name type))
135 (format t "~&------------------------------")
137 (dolist (elem spec-format)
138 (format t "~&Enter ~A: " elem)
139 (push (read-line) spec))