X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-basic.lisp;h=cbcd8fa715af85c59d09e78a82becc3884442e45;hp=598879bd1aca96e01aa2e1eb0b498de7979d0fe1;hb=refs%2Ftags%2Fv3.8.6;hpb=e303385b84c6246c7d60ebd95d764a282a181a23 diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index 598879b..cbcd8fa 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Created: Mar 2002 ;;;; -;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $ +;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg ;;;; @@ -18,182 +18,207 @@ (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-sys:number-to-sql-string test-flt) - (transform-bigint-1 test-int) - (clsql-sys: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 may return returns bigints as strings or integer - ;; depending upon the platform - t - (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) - results) - (destructuring-bind (int float bigint str) row - (setq results - (cons (list (double-float-equal - (transform-float-1 int) - float) - (double-float-equal - (parse-double str) - float)) - results)))) - results) +(setq *rt-basic* + '( + (deftest :basic/type/1 + (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 + (let ((results '())) + (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) + results) + (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))) - ))) - -(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/1 + (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) + (values + (length rows) + (length (car rows)))) + 11 3) + (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 - (declare (ignore bigint)) - (push (list (double-float-equal - (transform-float-1 (parse-integer int)) - (parse-double float)) - (double-float-equal - (parse-double str) - (parse-double float))) - results)))) + (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 + (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 - (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 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 #'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 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/3 - (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 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" :result-types nil) - (declare (ignore bigint)) - (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) + (deftest :basic/map/1 + (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 + (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 + (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 + (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 + (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 - (let ((results '())) - (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto) - (declare (ignore bigint)) - (setq results - (cons - (list (double-float-equal - (transform-float-1 int) - float) - (double-float-equal - (parse-double str) - float)) - results))) - results) + (deftest :basic/do/2 + (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))) + 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/bigint/1 + (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))) + )) +(defun test-basic-initialize () + (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))") + + (if (clsql-sys:db-type-has-bigint? *test-database-type*) + (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer, t_bigint BIGINT)") + (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer)")) + + (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) + )) + (when (clsql-sys:db-type-has-bigint? *test-database-type*) + (clsql:execute-command + (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)" + test-int + (transform-bigint-1 test-int) + )))))) + ;;;; Testing functions (defun transform-float-1 (i) @@ -209,9 +234,9 @@ (defun double-float-equal (a b) (if (zerop a) (if (zerop b) - t - nil) + t + nil) (let ((diff (abs (/ (- a b) a)))) - (if (> diff (* 10 double-float-epsilon)) - nil - t)))) + (if (> diff (* 10 double-float-epsilon)) + nil + t))))