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)
195 ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
198 (deftest :basic/bigtext/1
199 (with-dataset *ds-bigtext*
201 (str (make-string len :initial-element #\a))
202 (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
203 (execute-command cmd)
204 (let ((a (first (query "SELECT a from testbigtext"
205 :flatp t :field-names nil))))
206 (assert (string= str a) (str a)
207 "mismatch on a. inserted: ~a returned: ~a" len (length a)))
210 (deftest :basic/bigtext/2
211 (flet ((random-char ()
212 (let ((alphabet "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
214 (elt alphabet idx))))
216 (with-dataset *ds-bigtext*
217 (let* ((len (random 7500))
218 (str (coerce (make-array len
219 :initial-contents (loop repeat len collect (random-char)))
221 (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
222 (execute-command cmd)
223 (let ((a (first (query "SELECT a from testbigtext"
224 :flatp t :field-names nil))))
225 (assert (string= str a) (str a)
226 "mismatch on randomized bigtext(~a) inserted: ~s returned: ~s" len str a))
232 (def-dataset *ds-basic*
235 (clsql:execute-command "DROP TABLE TYPE_TABLE")
236 (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
238 (clsql:execute-command
239 "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
242 (let* ((test-int (- i 5))
243 (test-flt (transform-float-1 test-int)))
244 (clsql:execute-command
245 (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
247 (clsql-sys:number-to-sql-string test-flt)
248 (clsql-sys:number-to-sql-string test-flt)
250 (:cleanup "DROP TABLE TYPE_TABLE"))
252 (def-dataset *ds-bigint*
254 (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
255 (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)")
257 (clsql:execute-command
258 (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
260 (transform-bigint-1 (- i 5)))))))
261 (:cleanup "DROP TABLE TYPE_BIGINT"))
263 ;;;; Testing functions
265 (defun transform-float-1 (i)
266 (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
268 (defun transform-bigint-1 (i)
269 (* i (expt 10 (* 3 (abs i)))))
271 (defun parse-double (num-str)
272 (let ((*read-default-float-format* 'double-float))
273 (coerce (read-from-string num-str) 'double-float)))
275 (defun double-float-equal (a b)
280 (let ((diff (abs (/ (- a b) a))))
281 (if (> diff (* 10 double-float-epsilon))
285 (def-dataset *ds-bigtext*
286 (:setup "CREATE TABLE testbigtext(a varchar(7500))")
287 (:cleanup "DROP TABLE testbigtext"))