test-suite/old-tests/interactive-test.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: interactive-test.cl,v 1.1 2002/04/20 22:51:42 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"
  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
  57 (defun create-test-table (db)
  58   (ignore-errors
  59     (clsql:execute-command
  60      "DROP TABLE test_clsql" :database db))
  61   (clsql:execute-command
  62    "CREATE TABLE test_clsql (n integer, n_pi float, n_pi_str CHAR(20))"
  63    :database db)
  64   (dotimes (i 11)
  65     (let ((n (- i 5)))
  66       (clsql:execute-command
  67        (format nil "INSERT INTO test_clsql VALUES (~a,~a,'~a')"
  68                n (clsql:float-to-sql-string (* pi n))
  69                (clsql:float-to-sql-string (* pi n)))
  70        :database db))))
  71
  72 (defun drop-test-table (db)
  73   (clsql:execute-command "DROP TABLE test_clsql"))
  74
  75 (defun clsql-test-table (spec type)
  76   (when (eq type :mysql)
  77     (test-clsql-mysql spec))
  78   (let ((db (clsql:connect spec :database-type type :if-exists :new)))
  79     (unwind-protect
  80         (progn
  81           (create-test-table db)
  82           (pprint (clsql:query "select * from test_clsql"
  83                                :database db
  84                                :types :auto))
  85           (pprint (clsql:map-query 'vector #'list "select * from test_clsql"
  86                                    :database db
  87                                    :types :auto)) ;;'(:int :double t)))
  88           (drop-test-table db))
  89       (clsql:disconnect :database db)))
  90   )
  91
  92 (defun test-clsql-mysql (spec)
  93   (let ((db (clsql-mysql::database-connect spec :mysql)))
  94     (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
  95     (clsql-mysql::database-execute-command
  96      "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
  97     (dotimes (i 10)
  98       (clsql-mysql::database-execute-command
  99        (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
 100                i (sqrt i) (format nil "~d" (sqrt i)))
 101        db))
 102     (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
 103       (format t "~&Number rows: ~D~%" (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
 104       (clsql-mysql::database-dump-result-set res db))
 105     (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
 106     (clsql-mysql::database-disconnect db)))
 107
 108
 109 (defun get-spec-and-type ()
 110   (format t "~&Test CLSQL")
 111   (format t "~&==========~%")
 112   (format t "~&Enter connection type (:mysql :postgresql :postgresql-socket")
 113   #+allegro (format t " :aodbc")
 114   (format t ") [default END]: ")
 115   (let ((type-string (read-line)))
 116     (if (zerop (length type-string))
 117         (values nil nil)
 118         (get-spec-for-type (read-from-string type-string)))))
 119
 120 (defun get-spec-for-type (type)
 121   (let ((spec (get-spec-using-format type
 122                         (ecase type
 123                           ((:mysql :postgresql :postgresql-socket)
 124                            '("host" "database" "user" "password"))
 125                           (:aodbc
 126                            '("dsn" "user" "password"))))))
 127     (values spec type)))
 128
 129
 130 (defun get-spec-using-format (type spec-format)
 131   (let (spec)
 132     (format t "~&Connection Spec for ~A" (symbol-name type))
 133     (format t "~&------------------------------")
 134
 135     (dolist (elem spec-format)
 136       (format t "~&Enter ~A: " elem)
 137       (push (read-line) spec))
 138     (nreverse spec)))