1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-fddl.lisp
4 ;;;; Authors: Marcus Pearce <m.t.pearce@city.ac.uk> and Kevin Rosenberg
5 ;;;; Created: 30/03/2004
8 ;;;; Tests for the CLSQL Functional Data Definition Language
11 ;;;; This file is part of CLSQL.
13 ;;;; CLSQL users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
16 ;;;; ======================================================================
18 (in-package #:clsql-tests
)
20 #.
(clsql:locally-enable-sql-reader-syntax
)
25 ;; list current tables
26 (deftest :fddl
/table
/1
27 (sort (mapcar #'string-downcase
28 (clsql:list-tables
:owner
*test-database-user
*))
30 ("addr" "big" "company" "ea_join" "employee" "type_bigint" "type_table"))
32 ;; create a table, test for its existence, drop it and test again
33 (deftest :fddl
/table
/2
34 (progn (clsql:create-table
[foo]
38 ([comments] longchar)))
40 (clsql:table-exists-p [foo] :owner
*test-database-user
*)
42 (clsql:drop-table
[foo] :if-does-not-exist :ignore)
43 (clsql:table-exists-p [foo] :owner
*test-database-user
*))))
46 ;; create a table, list its attributes and drop it
47 (deftest :fddl
/table
/3
49 (progn (clsql:create-table
[foo]
53 ([comments] longchar)))
55 (sort (mapcar #'string-downcase
56 (clsql:list-attributes [foo]))
58 (clsql:drop-table
[foo] :if-does-not-exist :ignore))))
59 "comments" "height" "id" "name")
61 (deftest :fddl/table/4
63 (clsql:table-exists-p "MyMixedCase")
65 (clsql:create-table "MyMixedCase" '(([a] integer)))
66 (clsql:table-exists-p "MyMixedCase"))
68 (clsql:drop-table "MyMixedCase")
69 (clsql:table-exists-p "MyMixedCase")))
72 (deftest :fddl/table/5
75 (clsql:create-table "MyMixedCase" '(([a] integer)))
76 (clsql:execute-command "insert into \"MyMixedCase\" values (5)")
77 (clsql:insert-records :into "MyMixedCase" :values '(6))
78 (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
79 (clsql:drop-table "MyMixedCase"))
82 (deftest :fddl/table/6
84 (clsql:table-exists-p [foo])
86 (let ((*backend-warning-behavior
*
87 (if (member *test-database-type
*
88 '(:postgresql
:postgresql-socket
))
91 (case *test-database-underlying-type
*
92 (:mssql
(clsql:create-table
[foo]
93 '(([bar] integer :not-null :primary-key)
94 ([baz] string :not-null :unique))))
95 (t (clsql:create-table [foo]
96 '(([bar] integer :not-null :unique :primary-key)
97 ([baz] string :not-null :unique))))))
98 (clsql:table-exists-p [foo]))
100 (clsql:drop-table [foo])
101 (clsql:table-exists-p [foo])))
104 (deftest :fddl/table/7
106 (clsql:table-exists-p [foo])
108 (let ((*backend-warning-behavior*
109 (if (member *test-database-type*
110 '(:postgresql :postgresql-socket))
113 (clsql:create-table [foo] '(([bar] integer
:not-null
)
114 ([baz] string :not-null))
115 :constraints '("UNIQUE (bar,baz)"
116 "PRIMARY KEY (bar)")))
117 (clsql:table-exists-p [foo]))
119 (clsql:drop-table [foo])
120 (clsql:table-exists-p [foo])))
123 (deftest :fddl/attributes/1
126 (mapcar #'string-downcase
127 (clsql:list-attributes [employee]
128 :owner *test-database-user*))
130 "bd_utime" "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
131 "last_name" "managerid" "married")
133 (deftest :fddl/attributes/2
136 (mapcar #'(lambda (a) (string-downcase (car a)))
137 (clsql:list-attribute-types [employee]
138 :owner *test-database-user*))
140 "bd_utime" "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
141 "last_name" "managerid" "married")
143 ;; Attribute types are vendor specific so need to test a range
144 (deftest :fddl/attributes/3
145 (and (member (clsql:attribute-type [emplid] [employee]) '(:int :integer :int4 :number)) t)
148 (deftest :fddl/attributes/4
149 (multiple-value-bind (type length scale nullable)
150 (clsql:attribute-type [first-name] [employee])
151 (values (clsql-sys:in type :varchar :varchar2) length scale nullable))
154 (deftest :fddl/attributes/5
155 (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp :date)) t)
158 (deftest :fddl/attributes/6
159 (and (member (clsql:attribute-type [height] [employee]) '(:float :float8 :number)) t)
162 (deftest :fddl/attributes/7
163 (and (member (clsql:attribute-type [bd_utime] [employee]) '(:bigint :int8 :char)) t)
167 ;; create a view, test for existence, drop it and test again
168 (deftest :fddl/view/1
169 (progn (clsql:create-view [lenins-group]
170 :as [select [first-name] [last-name] [email]
172 :where [= [managerid] 1]])
174 (clsql:view-exists-p [lenins-group] :owner *test-database-user*)
176 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
177 (clsql:view-exists-p [lenins-group] :owner *test-database-user*))))
180 ;; create a view, list its attributes and drop it
181 (when (clsql-sys:db-type-has-views? *test-database-underlying-type*)
182 (deftest :fddl/view/2
183 (progn (clsql:create-view [lenins-group]
184 :as [select [first-name] [last-name] [email]
186 :where [= [managerid] 1]])
188 (sort (mapcar #'string-downcase
189 (clsql:list-attributes [lenins-group]))
191 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)))
192 ("email" "first_name" "last_name")))
194 ;; create a view, select stuff from it and drop it
195 (deftest :fddl/view/3
196 (progn (clsql:create-view [lenins-group]
197 :as [select [first-name] [last-name] [email]
199 :where [= [managerid] 1]])
203 (clsql:select [first-name] [last-name] [email]
205 :where [= [last-name] "Lenin"])
207 (car (clsql:select [first-name] [last-name] [email]
209 :where [= [last-name] "Stalin"])))))
210 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
211 (apply #'values result)))
212 nil ("Josef" "Stalin" "stalin@soviet.org"))
214 (deftest :fddl/view/4
215 (progn (clsql:create-view [lenins-group]
216 :column-list '([forename] [surname] [email])
217 :as [select [first-name] [last-name] [email]
219 :where [= [managerid] 1]])
223 (clsql:select [forename] [surname] [email]
225 :where [= [surname] "Lenin"])
227 (car (clsql:select [forename] [surname] [email]
229 :where [= [surname] "Stalin"])))))
230 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
231 (apply #'values result)))
232 nil ("Josef" "Stalin" "stalin@soviet.org"))
234 ;; create an index, test for existence, drop it and test again
235 (deftest :fddl/index/1
236 (progn (clsql:create-index [bar] :on [employee] :attributes
237 '([first-name] [last-name] [email]) :unique t)
239 (clsql:index-exists-p [bar] :owner *test-database-user*)
241 (clsql:drop-index [bar] :on [employee]
242 :if-does-not-exist :ignore)
243 (clsql:index-exists-p [bar] :owner *test-database-user*))))
246 ;; create indexes with names as strings, symbols and in square brackets
247 (deftest :fddl/index/2
248 (let ((names '("foo" foo [foo]))
251 (clsql:create-index name :on [employee] :attributes '([last-name]))
252 (push (clsql:index-exists-p name :owner *test-database-user*) result)
253 (clsql:drop-index name :on [employee] :if-does-not-exist :ignore))
254 (apply #'values result))
257 ;; test list-indexes with keyword :ON
258 (deftest :fddl/index/3
260 (clsql:create-table [i3test] '(([a] (string 10))
262 (clsql:create-index [foo] :on [i3test] :attributes
264 (clsql:create-index [bar] :on [i3test] :attributes
267 (clsql:table-exists-p [i3test])
268 (clsql:index-exists-p [foo])
269 (clsql:index-exists-p [bar])
273 (clsql:list-indexes :on [i3test] :owner *test-database-user*))
276 (clsql:drop-index [bar] :on [i3test])
277 (clsql:drop-index [foo] :on [i3test])
278 (clsql:drop-table [i3test])
280 t t t ("bar" "foo") t)
282 ;; create an sequence, test for existence, drop it and test again
283 (deftest :fddl/sequence/1
284 (progn (clsql:create-sequence [foo])
286 (clsql:sequence-exists-p [foo] :owner *test-database-user*)
288 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
289 (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
292 ;; create and increment a sequence
293 (deftest :fddl/sequence/2
295 (clsql:create-sequence [foo])
296 (setf val1 (clsql:sequence-next [foo]))
298 (< val1 (clsql:sequence-next [foo]))
299 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
302 ;; explicitly set the value of a sequence
303 (deftest :fddl/sequence/3
305 (clsql:create-sequence [foo])
306 (clsql:set-sequence-position [foo] 5)
308 (clsql:sequence-next [foo])
309 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
313 (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil)))
318 (rest rows (cdr rest)))
319 ((= i (length rows)) t)
321 (int (first (car rest)))
322 (bigint (second (car rest))))
323 (when (and (or (eq *test-database-type* :oracle)
324 (and (eq *test-database-type* :odbc)
325 (eq *test-database-underlying-type* :postgresql)))
327 (setf bigint (parse-integer bigint)))
328 (unless (and (eql int index)
329 (eql bigint (truncate max index)))
333 (deftest :fddl/owner/1
335 ;; user tables are an improper subset of all tables
336 (= (length (intersection (clsql:list-tables :owner nil)
337 (clsql:list-tables :owner :all)
339 (length (clsql:list-tables :owner nil)))
340 ;; user tables are a proper subset of all tables
341 (> (length (clsql:list-tables :owner :all))
342 (length (clsql:list-tables :owner nil))))
345 (deftest :fddl/cache-table-queries/1
347 (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*))
349 (clsql:cache-table-queries "EMPLOYEE" :action t)
350 (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*)))
352 (clsql:list-attribute-types "EMPLOYEE")
357 (clsql-sys::attribute-cache clsql:*default-database*))))))
359 (clsql:cache-table-queries "EMPLOYEE" :action :flush)
360 (gethash "EMPLOYEE" (clsql-sys::attribute-cache clsql:*default-database*))))
361 (nil (t nil) t (t nil)))
365 #.(clsql:restore-sql-reader-syntax-state)