test-clsql.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          test-clsql.cl
   6 ;;;; Purpose:       Basic test of CLSQL
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Mar 2002
   9 ;;;;
  10 ;;;; $Id: test-clsql.cl,v 1.10 2002/03/27 05:04:19 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;;
  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 ;;;; *************************************************************************
  18
  19 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  20 (in-package :cl-user)
  21
  22
  23 (defvar *config-pathname* (make-pathname :name "test-clsql"
  24                                          :type "config"
  25                                          :defaults *load-truename*))
  26 (defparameter *config* nil)
  27
  28 (defun do-test (&optional (interactive nil))
  29   (if interactive
  30       (test-interactive)
  31     (if (probe-file *config-pathname*)
  32         (with-open-file (stream *config-pathname* :direction :input)
  33           (setq *config* (read stream))
  34           (test-automated *config*))
  35       (test-interactive))))
  36
  37 (defun test-interactive ()
  38   (do ((done nil))
  39       (done)
  40     (multiple-value-bind (spec type) (get-spec-and-type)
  41       (if spec
  42           (clsql-test-table spec type)
  43           (setq done t)))))
  44
  45 (defun test-automated (config)
  46   (dolist (elem config)
  47     (let ((type (car elem))
  48           (spec (cadr elem)))
  49       #-allegro
  50       (unless (eq type :aodbc)
  51         (clsql-test-table spec type))
  52       #+allegro
  53       (clsql-test-table spec type)))
  54   )
  55
  56 (defun make-test-float (i)
  57   (* i (expt 10 (* i 4))))
  58
  59 (defun create-test-table (db)
  60   (ignore-errors
  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))"
  65    :database db)
  66   (dotimes (i 11)
  67     (let ((n (- i 5)))
  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)))
  72        :database db))))
  73
  74 (defun drop-test-table (db)
  75   (clsql:execute-command "DROP TABLE test_clsql"))
  76
  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)))
  81     (unwind-protect
  82         (progn
  83           (create-test-table db)
  84           (pprint (clsql:query "select * from test_clsql"
  85                                :database db
  86                                :types nil))
  87           (pprint (clsql:map-query 'vector #'list "select * from test_clsql"
  88                                    :database db
  89                                    :types :auto)) ;;'(:int :double t)))
  90           (drop-test-table db))
  91       (clsql:disconnect :database db)))
  92   )
  93
  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)
  99     (dotimes (i 10)
 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)))
 103        db))
 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)))
 109
 110
 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))
 119         (values nil nil)
 120         (get-spec-for-type (read-from-string type-string)))))
 121
 122 (defun get-spec-for-type (type)
 123   (let ((spec (get-spec-using-format type
 124                         (ecase type
 125                           ((:mysql :postgresql :postgresql-socket)
 126                            '("host" "database" "user" "password"))
 127                           (:aodbc
 128                            '("dsn" "user" "password"))))))
 129     (values spec type)))
 130
 131
 132 (defun get-spec-using-format (type spec-format)
 133   (let (spec)
 134     (format t "~&Connection Spec for ~A" (symbol-name type))
 135     (format t "~&------------------------------")
 136
 137     (dolist (elem spec-format)
 138       (format t "~&Enter ~A: " elem)
 139       (push (read-line) spec))
 140     (nreverse spec)))