X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-basic.lisp;h=b0e85875b5dedc5fe90ebe09efbc4c806cbb68d5;hp=aff45cb6ffab18cabf7fd5b8c50185aea3446312;hb=d2d49ab13c98bc7a1819a0fd3968268a5567bdc3;hpb=41c5da5bdc34fdc6ea25928ea0f94fcf0ff5c6e3 diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index aff45cb..b0e8587 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -3,13 +3,11 @@ ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: test-basic.lisp -;;;; Purpose: Tests for clsql-base and result types +;;;; Purpose: Tests for clsql string-based queries and result types ;;;; Author: Kevin M. Rosenberg ;;;; Created: Mar 2002 ;;;; -;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg +;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -18,144 +16,249 @@ (in-package #:clsql-tests) -(defun test-basic-initialize () - (ignore-errors - (clsql:execute-command "DROP TABLE TYPE_TABLE")) - (clsql:execute-command - "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_bigint BIGINT, t_str VARCHAR(30))") - (dotimes (i 11) - (let* ((test-int (- i 5)) - (test-flt (transform-float-1 test-int))) - (clsql:execute-command - (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')" - test-int - (clsql-base:number-to-sql-string test-flt) - (transform-bigint-1 test-int) - (clsql-base:number-to-sql-string test-flt) - ))))) - -(defun test-basic-forms () - (append - (test-basic-forms-untyped) - '( - (deftest :BASIC/TYPE/1 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) - results) - (destructuring-bind (int float bigint str) row - (push (list (integerp int) - (typep float 'double-float) - (if (and (eq :odbc *test-database-type*) - (eq :postgresql *test-database-underlying-type*)) - ;; ODBC/Postgresql returns bigints as strings - (stringp bigint) - (integerp bigint)) - (stringp str)) - results)))) - ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t))) - - - (deftest :BASIC/TYPE/2 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) + +(setq *rt-basic* + '( + (deftest :basic/type/1 + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) + results) + (destructuring-bind (int float str) row + (push (list (integerp int) + (typep float 'double-float) + (stringp str)) + results))))) + ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t))) + + (deftest :basic/type/2 + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) results) - (destructuring-bind (int float bigint str) row - (push (list (double-float-equal + (destructuring-bind (int float str) row + (setq results + (cons (list (double-float-equal + (transform-float-1 int) + float) + (double-float-equal + (parse-double str) + float)) + results)))) + results)) + ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) + + (deftest :basic/select/1 + (with-dataset *ds-basic* + (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) + (values + (length rows) + (length (car rows))))) + 11 3) + + (deftest :BASIC/SELECT/2 + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types nil) + results) + (destructuring-bind (int float str) row + (push (list (stringp int) + (stringp float) + (stringp str)) + results))))) + ((t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t) (t t t))) + + (deftest :basic/select/3 + (with-dataset *ds-basic* + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types nil) + results) + (destructuring-bind (int float str) row + (push (list (double-float-equal + (transform-float-1 (parse-integer int)) + (parse-double float)) + (double-float-equal + (parse-double str) + (parse-double float))) + results))))) + ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) + + (deftest :basic/map/1 + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'vector #'identity "select * from TYPE_TABLE" + :result-types nil))) + (declare (type (simple-array list (*)) rows)) + (dotimes (i (length rows) results) + (push + (list + (listp (aref rows i)) + (length (aref rows i)) + (eql (- i 5) + (parse-integer (first (aref rows i)) + :junk-allowed nil)) + (double-float-equal + (transform-float-1 (parse-integer (first (aref rows i)))) + (parse-double (second (aref rows i))))) + results)))) + ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) + + + (deftest :basic/map/2 + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'list #'identity "select * from TYPE_TABLE" + :result-types nil))) + (dotimes (i (length rows) results) + (push + (list + (listp (nth i rows)) + (length (nth i rows)) + (eql (- i 5) + (parse-integer (first (nth i rows)) + :junk-allowed nil)) + (double-float-equal + (transform-float-1 (parse-integer (first (nth i rows)))) + (parse-double (second (nth i rows))))) + results)))) + ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) + + (deftest :basic/map/3 + (with-dataset *ds-basic* + (let ((results '()) + (rows (map-query 'list #'identity "select * from TYPE_TABLE" + :result-types :auto))) + (dotimes (i (length rows) results) + (push + (list + (listp (nth i rows)) + (length (nth i rows)) + (eql (- i 5) + (first (nth i rows))) + (double-float-equal + (transform-float-1 (first (nth i rows))) + (second (nth i rows)))) + results)))) + ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t))) + + ;; confirm that a query on a single element returns a list of one element + (deftest :basic/map/4 + (with-dataset *ds-basic* + (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE" + :result-types nil))) + (values + (consp (first rows)) + (length (first rows))))) + t 1) + + (deftest :basic/do/1 + (with-dataset *ds-basic* + (let ((results '())) + (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil) + (let ((int-number (parse-integer int))) + (setq results + (cons (list (double-float-equal (transform-float-1 + int-number) + (parse-double float)) + (double-float-equal (parse-double str) + (parse-double float))) + results)))) + results)) + ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) + + (deftest :basic/do/2 + (with-dataset *ds-basic* + (let ((results '())) + (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto) + (setq results + (cons + (list (double-float-equal (transform-float-1 int) float) (double-float-equal (parse-double str) float)) - results)))) - ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) - ))) - -(defun test-basic-forms-untyped () - '((deftest :BASIC/SELECT/1 - (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) - (values - (length rows) - (length (car rows)))) - 11 4) - - (deftest :BASIC/SELECT/2 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types nil) - results) - (destructuring-bind (int float bigint str) row - (push (list (stringp int) - (stringp float) - (stringp bigint) - (stringp str)) - results)))) - ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t))) - - (deftest :BASIC/SELECT/3 - (let ((results '())) - (dolist (row (query "select * from TYPE_TABLE" :result-types nil) - results) - (destructuring-bind (int float bigint str) row - (push (list (double-float-equal - (transform-float-1 (parse-integer int)) - (parse-double float)) - (double-float-equal - (parse-double str) - (parse-double float))) - results)))) + results))) + results)) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) - (deftest :BASIC/MAP/1 - (let ((results '()) - (rows (map-query 'vector #'list "select * from TYPE_TABLE" - :result-types nil))) - (declare (array rows)) - (dotimes (i (length rows) results) - (push - (list - (listp (aref rows i)) - (length (aref rows i)) - (eql (- i 5) - (parse-integer (first (aref rows i)) - :junk-allowed nil)) - (double-float-equal - (transform-float-1 (parse-integer (first (aref rows i)))) - (parse-double (second (aref rows i))))) - results))) - ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t))) - - (deftest :BASIC/MAP/2 - (let ((results '()) - (rows (map-query 'list #'list "select * from TYPE_TABLE" - :result-types nil))) - (dotimes (i (length rows) results) - (push - (list - (listp (nth i rows)) - (length (nth i rows)) - (eql (- i 5) - (parse-integer (first (nth i rows)) - :junk-allowed nil)) - (double-float-equal - (transform-float-1 (parse-integer (first (nth i rows)))) - (parse-double (second (nth i rows))))) - results))) - ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t))) - - (deftest :BASIC/DO/1 - (let ((results '())) - (do-query ((int float bigint str) "select * from TYPE_TABLE") - (push (list (double-float-equal - (transform-float-1 (parse-integer int)) - (parse-double float)) - (double-float-equal - (parse-double str) - (parse-double float))) - results)) - results) + + (deftest :basic/bigint/1 + (with-dataset *ds-bigint* + (let ((results '())) + (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto) + results) + (destructuring-bind (int bigint) row + (push (list (integerp int) + (if (and (eq :odbc *test-database-type*) + (eq :postgresql *test-database-underlying-type*)) + ;; ODBC/Postgresql may return returns bigints as strings or integer + ;; depending upon the platform + t + (integerp bigint))) + results))))) ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t))) + + + (deftest :basic/bigtext/1 + (with-dataset *ds-bigtext* + (let* ((len 7499) + (str (make-string len :initial-element #\a)) + (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str))) + (execute-command cmd) + (let ((a (first (query "SELECT a from testbigtext" + :flatp t :field-names nil)))) + (assert (string= str a) (str a) + "mismatch on a. inserted: ~a returned: ~a" len (length a))) + )) + nil) + (deftest :basic/bigtext/2 + (dotimes (n 10) + (with-dataset *ds-bigtext* + (let* ((len (random 7500)) + (str (make-string len :initial-element #\a)) + (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str))) + (execute-command cmd) + (let ((a (first (query "SELECT a from testbigtext" + :flatp t :field-names nil)))) + (assert (string= str a) (str a) + "mismatch on a. inserted: ~a returned: ~a" len (length a))) + ))) + nil) )) +(def-dataset *ds-basic* + (:setup (lambda () + (ignore-errors + (clsql:execute-command "DROP TABLE TYPE_TABLE") + (clsql:execute-command "DROP TABLE TYPE_BIGINT")) + + (clsql:execute-command + "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))") + + (dotimes (i 11) + (let* ((test-int (- i 5)) + (test-flt (transform-float-1 test-int))) + (clsql:execute-command + (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')" + test-int + (clsql-sys:number-to-sql-string test-flt) + (clsql-sys:number-to-sql-string test-flt) + )))))) + (:cleanup "DROP TABLE TYPE_TABLE")) + +(def-dataset *ds-bigint* + (:setup (lambda () + (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT")) + (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)") + (dotimes (i 11) + (clsql:execute-command + (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)" + (- i 5) + (transform-bigint-1 (- i 5))))))) + (:cleanup "DROP TABLE TYPE_BIGINT")) + ;;;; Testing functions (defun transform-float-1 (i) @@ -177,3 +280,7 @@ (if (> diff (* 10 double-float-epsilon)) nil t)))) + +(def-dataset *ds-bigtext* + (:setup "CREATE TABLE testbigtext(a varchar(7500))") + (:cleanup "DROP TABLE testbigtext"))