1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: test-basic.lisp
6 ;;;; Purpose: Tests for clsql string-based queries and result types
7 ;;;; Author: Kevin M. Rosenberg
10 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:clsql-tests)
22 (deftest :basic/type/1
23 (with-dataset *ds-basic*
25 (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
27 (destructuring-bind (int float str) row
28 (push (list (integerp int)
29 (typep float 'double-float)
32 ((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)))
34 (deftest :basic/type/2
35 (with-dataset *ds-basic*
37 (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
39 (destructuring-bind (int float str) row
41 (cons (list (double-float-equal
42 (transform-float-1 int)
49 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
51 (deftest :basic/select/1
52 (with-dataset *ds-basic*
53 (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
56 (length (car rows)))))
59 (deftest :BASIC/SELECT/2
60 (with-dataset *ds-basic*
62 (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
64 (destructuring-bind (int float str) row
65 (push (list (stringp int)
69 ((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)))
71 (deftest :basic/select/3
72 (with-dataset *ds-basic*
74 (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
76 (destructuring-bind (int float str) row
77 (push (list (double-float-equal
78 (transform-float-1 (parse-integer int))
82 (parse-double float)))
84 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
87 (with-dataset *ds-basic*
89 (rows (map-query 'vector #'identity "select * from TYPE_TABLE"
91 (declare (type (simple-array list (*)) rows))
92 (dotimes (i (length rows) results)
96 (length (aref rows i))
98 (parse-integer (first (aref rows i))
101 (transform-float-1 (parse-integer (first (aref rows i))))
102 (parse-double (second (aref rows i)))))
104 ((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)))
107 (deftest :basic/map/2
108 (with-dataset *ds-basic*
110 (rows (map-query 'list #'identity "select * from TYPE_TABLE"
112 (dotimes (i (length rows) results)
116 (length (nth i rows))
118 (parse-integer (first (nth i rows))
121 (transform-float-1 (parse-integer (first (nth i rows))))
122 (parse-double (second (nth i rows)))))
124 ((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)))
126 (deftest :basic/map/3
127 (with-dataset *ds-basic*
129 (rows (map-query 'list #'identity "select * from TYPE_TABLE"
130 :result-types :auto)))
131 (dotimes (i (length rows) results)
135 (length (nth i rows))
137 (first (nth i rows)))
139 (transform-float-1 (first (nth i rows)))
140 (second (nth i rows))))
142 ((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)))
144 ;; confirm that a query on a single element returns a list of one element
145 (deftest :basic/map/4
146 (with-dataset *ds-basic*
147 (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE"
151 (length (first rows)))))
155 (with-dataset *ds-basic*
157 (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil)
158 (let ((int-number (parse-integer int)))
160 (cons (list (double-float-equal (transform-float-1
162 (parse-double float))
163 (double-float-equal (parse-double str)
164 (parse-double float)))
167 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
170 (with-dataset *ds-basic*
172 (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto)
175 (list (double-float-equal
176 (transform-float-1 int)
183 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
186 (deftest :basic/bigint/1
187 (with-dataset *ds-bigint*
189 (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto)
191 (destructuring-bind (int bigint) row
192 (push (list (integerp int)
193 (if (and (eq :odbc *test-database-type*)
194 (eq :postgresql *test-database-underlying-type*))
195 ;; ODBC/Postgresql may return returns bigints as strings or integer
196 ;; depending upon the platform
200 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
203 (deftest :basic/bigtext/1
204 (with-dataset *ds-bigtext*
206 (str (make-string len :initial-element #\a))
207 (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
208 (execute-command cmd)
209 (let ((a (first (query "SELECT a from testbigtext"
210 :flatp t :field-names nil))))
211 (assert (string= str a) (str a)
212 "mismatch on a. inserted: ~a returned: ~a" len (length a)))
215 (deftest :basic/bigtext/2
217 (with-dataset *ds-bigtext*
218 (let* ((len (random 7500))
219 (str (make-string len :initial-element #\a))
220 (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
221 (execute-command cmd)
222 (let ((a (first (query "SELECT a from testbigtext"
223 :flatp t :field-names nil))))
224 (assert (string= str a) (str a)
225 "mismatch on a. inserted: ~a returned: ~a" len (length a)))
231 (def-dataset *ds-basic*
234 (clsql:execute-command "DROP TABLE TYPE_TABLE")
235 (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
237 (clsql:execute-command
238 "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
241 (let* ((test-int (- i 5))
242 (test-flt (transform-float-1 test-int)))
243 (clsql:execute-command
244 (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
246 (clsql-sys:number-to-sql-string test-flt)
247 (clsql-sys:number-to-sql-string test-flt)
249 (:cleanup "DROP TABLE TYPE_TABLE"))
251 (def-dataset *ds-bigint*
253 (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
254 (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)")
256 (clsql:execute-command
257 (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
259 (transform-bigint-1 (- i 5)))))))
260 (:cleanup "DROP TABLE TYPE_BIGINT"))
262 ;;;; Testing functions
264 (defun transform-float-1 (i)
265 (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
267 (defun transform-bigint-1 (i)
268 (* i (expt 10 (* 3 (abs i)))))
270 (defun parse-double (num-str)
271 (let ((*read-default-float-format* 'double-float))
272 (coerce (read-from-string num-str) 'double-float)))
274 (defun double-float-equal (a b)
279 (let ((diff (abs (/ (- a b) a))))
280 (if (> diff (* 10 double-float-epsilon))
284 (def-dataset *ds-bigtext*
285 (:setup "CREATE TABLE testbigtext(a varchar(7500))")
286 (:cleanup "DROP TABLE testbigtext"))