X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-basic.lisp;h=1cd09d2b50fe1171da577a48444b2f093e5597a6;hb=6b773c9d859a10b961df9c1c2c9b8a006b315aff;hp=85874a4d4ed3015ed25b2b035117b5666d0de9cd;hpb=1dda729b250779079efbdc1d3f6bbb3ae4a20ba4;p=clsql.git diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index 85874a4..1cd09d2 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -3,7 +3,7 @@ ;;;; 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 ;;;; @@ -18,83 +18,58 @@ (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 +(setq *rt-basic* + '( + (deftest :BASIC/TYPE/1 (let ((results '())) (dolist (row (query "select * from TYPE_TABLE" :result-types :auto) - results) - (destructuring-bind (int float bigint str) row + results) + (destructuring-bind (int float 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))) - + ((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 + (deftest :BASIC/TYPE/2 (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 - (transform-float-1 int) - float) - (double-float-equal - (parse-double str) - float)) - 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 + (deftest :BASIC/SELECT/1 (let ((rows (query "select * from TYPE_TABLE" :result-types :auto))) (values (length rows) (length (car rows)))) - 11 4) + 11 3) - (deftest BASIC/SELECT/2 + (deftest :BASIC/SELECT/2 (let ((results '())) (dolist (row (query "select * from TYPE_TABLE" :result-types nil) results) - (destructuring-bind (int float bigint str) row + (destructuring-bind (int float 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))) + ((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 + (deftest :BASIC/SELECT/3 (let ((results '())) (dolist (row (query "select * from TYPE_TABLE" :result-types nil) results) - (destructuring-bind (int float bigint str) row + (destructuring-bind (int float str) row (push (list (double-float-equal (transform-float-1 (parse-integer int)) (parse-double float)) @@ -104,11 +79,11 @@ 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 + (deftest :BASIC/MAP/1 (let ((results '()) - (rows (map-query 'vector #'list "select * from TYPE_TABLE" + (rows (map-query 'vector #'identity "select * from TYPE_TABLE" :result-types nil))) - (declare (array rows)) + (declare (type (simple-array list (*)) rows)) (dotimes (i (length rows) results) (push (list @@ -121,11 +96,11 @@ (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))) + ((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 + (deftest :BASIC/MAP/2 (let ((results '()) - (rows (map-query 'list #'list "select * from TYPE_TABLE" + (rows (map-query 'list #'identity "select * from TYPE_TABLE" :result-types nil))) (dotimes (i (length rows) results) (push @@ -139,23 +114,101 @@ (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))) + ((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))) - (deftest BASIC/DO/1 + (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)) + (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 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)