X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=test-suite%2Fxptest-clsql.cl;h=2134763f7c9445c9e45d856e1741ac29a3573153;hb=efcfb26c347150ecbfc77916b05da5e2796e24f0;hp=6d082274fd024e97022b197ec0a0d6f643e1ff1d;hpb=ed0ba77f1cff4820da69c6229018e06b9efad1b5;p=clsql.git diff --git a/test-suite/xptest-clsql.cl b/test-suite/xptest-clsql.cl index 6d08227..2134763 100644 --- a/test-suite/xptest-clsql.cl +++ b/test-suite/xptest-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: xptest-clsql.cl,v 1.6 2002/03/27 11:13:27 kevin Exp $ +;;;; $Id: xptest-clsql.cl,v 1.8 2002/03/27 12:27:47 kevin Exp $ ;;;; ;;;; The XPTest package can be downloaded from ;;;; http://alpha.onshored.com/lisp-software/ @@ -19,6 +19,17 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* + +;;; This test suite looks for a configuration file named "test.config" +;;; This file contains a single a-list that specifies the connection +;;; specs for each database type to be tested. For example, to test all +;;; platforms, a sample "test.config" may look like: +;;; +;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret")) +;;; (:aodbc ("my-dsn" "a-user" "pass")) +;;; (:paostgresql ("localhost" "another-db" "user2" "dont-tell")) +;;; (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password"))) + (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :cl-user) (mk:load-system "XPTest") @@ -89,10 +100,10 @@ (when (map-query nil #'list "select * from test_clsql" :database db :types :auto) (failure "Expected NIL result from map-query nil")) - (do-query ((int float str) "select * from test_clsql") - (test-table-row (list int float str) nil)) - (do-query ((int float str) "select * from test_clsql" :types :auto) - (test-table-row (list int float str) :auto)) + (do-query ((int float bigint str) "select * from test_clsql") + (test-table-row (list int float bigint str) nil)) + (do-query ((int float bigint str) "select * from test_clsql" :types :auto) + (test-table-row (list int float bigint str) :auto)) (drop-test-table db) ) (disconnect :database db))))) @@ -108,7 +119,8 @@ (dotimes (i 10) (clsql-mysql::database-execute-command (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')" - i (sqrt i) (format nil "~d" (sqrt i))) + i (number-to-sql-string (sqrt i)) + (number-to-sql-string (sqrt i))) db)) (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil))) (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res))) @@ -121,16 +133,16 @@ (make-test-suite "CLSQL Test Suite" "Basic test suite for database operations." - ("MySQL Low Level Interface Test" 'clsql-fixture + ("MySQL Low Level Interface" 'clsql-fixture :test-thunk 'mysql-low-level :description "A test of MySQL low-level interface") - ("MySQL Test" 'clsql-fixture + ("MySQL Table" 'clsql-fixture :test-thunk 'mysql-table-test :description "A test of MySQL") - ("PostgreSQL Test" 'clsql-fixture + ("PostgreSQL Table" 'clsql-fixture :test-thunk 'pgsql-table-test :description "A test of PostgreSQL tables") - ("PostgreSQL Socket Table Test" 'clsql-fixture + ("PostgreSQL Socket Table" 'clsql-fixture :test-thunk 'pgsql-socket-table-test :description "A test of PostgreSQL Socket tables") )) @@ -143,56 +155,63 @@ ;;;; Testing functions -(defun transform1 (i) +(defun transform-float-1 (i) (* i (abs (/ i 2)) (expt 10 (* 2 i)))) +(defun transform-bigint-1 (i) + (* i (expt 10 (* 3 (abs i))))) + (defun create-test-table (db) (ignore-errors (clsql:execute-command "DROP TABLE test_clsql" :database db)) (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float float, t_str CHAR(20))" + "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" :database db) (dotimes (i 11) (let* ((test-int (- i 5)) - (test-flt (transform1 test-int))) + (test-flt (transform-float-1 test-int))) (clsql:execute-command - (format nil "INSERT INTO test_clsql VALUES (~a,~a,'~a')" + (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" test-int (number-to-sql-string test-flt) - (number-to-sql-string test-flt)) + (transform-bigint-1 test-int) + (number-to-sql-string test-flt) + ) :database db)))) (defun parse-double (num-str) (let ((*read-default-float-format* 'double-float)) - (read-from-string num-str))) + (coerce (read-from-string num-str) 'double-float))) (defun test-table-row (row types) (unless (and (listp row) - (= 3 (length row))) + (= 4 (length row))) (failure "Row ~S is incorrect format" row)) - (destructuring-bind (int float str) row + (destructuring-bind (int float bigint str) row (cond ((eq types :auto) (unless (and (integerp int) (typep float 'double-float) + (integerp bigint) (stringp str)) (failure "Incorrect field type for row ~S" row))) ((null types) (unless (and (stringp int) (stringp float) + (stringp bigint) (stringp str)) (failure "Incorrect field type for row ~S" row)) - (setq int (parse-integer int)) - (setq float (parse-double float))) + (setq int (parse-integer int)) + (setq bigint (parse-integer bigint)) + (setq float (parse-double float))) ((listp types) + (error "NYI") ) (t (failure "Invalid types field (~S) passed to test-table-row" types))) -#+ignore - (unless (= float (transform1 int)) + (unless (= float (transform-float-1 int)) (failure "Wrong float value ~A for int ~A (row ~S)" float int row)) -#+ignore (unless (= float (parse-double str)) (failure "Wrong string value ~A" str))))