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)
22 (def-dataset *ds-fddl*
23 (:setup ("CREATE TABLE ALPHA (A integer, B integer, C varchar (30), d date, f float)"
24 "CREATE TABLE BRAVO (jack integer, jill integer)"))
25 (:sqldata "ALPHA" "A,B,C,d,f"
26 "1,1,'asdf','2010-01-01',3.14"
27 "2,1,'blarg','2012-12-21',0.1")
28 (:cleanup "DROP TABLE ALPHA" "DROP TABLE BRAVO"))
33 ;; list current tables
34 (deftest :fddl/table/1
35 (with-dataset *ds-fddl*
36 (sort (mapcar #'string-downcase
37 (clsql:list-tables :owner *test-database-user*))
41 ;; create a table, test for its existence, drop it and test again
42 (deftest :fddl/table/2
43 (progn (clsql:create-table [foo]
47 ([comments] longchar)))
49 (clsql:table-exists-p [foo] :owner *test-database-user*)
51 (clsql:drop-table [foo] :if-does-not-exist :ignore)
52 (clsql:table-exists-p [foo] :owner *test-database-user*))))
55 ;; create a table, list its attributes and drop it
56 (deftest :fddl/table/3
58 (progn (clsql:create-table [foo]
62 ([comments] longchar)))
64 (sort (mapcar #'string-downcase
65 (clsql:list-attributes [foo]))
67 (clsql:drop-table [foo] :if-does-not-exist :ignore))))
68 "comments" "height" "id" "name")
70 (deftest :fddl/table/4
72 (clsql:table-exists-p "MyMixedCase")
74 (clsql:create-table "MyMixedCase" '(([a] integer)))
75 (clsql:table-exists-p "MyMixedCase"))
77 (clsql:drop-table "MyMixedCase")
78 (clsql:table-exists-p "MyMixedCase")))
81 (deftest :fddl/table/5
84 (clsql:create-table "MyMixedCase" '(([a] integer)))
85 (clsql:execute-command "insert into \"MyMixedCase\" values (5)")
86 (clsql:insert-records :into "MyMixedCase" :values '(6))
87 (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
88 (clsql:drop-table "MyMixedCase"))
91 (deftest :fddl/table/6
93 (clsql:table-exists-p [foo])
95 (let ((*backend-warning-behavior*
96 (if (member *test-database-type*
97 '(:postgresql :postgresql-socket))
100 (case *test-database-underlying-type*
101 (:mssql (clsql:create-table [foo]
102 '(([bar] integer :not-null :primary-key)
103 ([baz] string :not-null :unique))))
104 (t (clsql:create-table [foo]
105 '(([bar] integer :not-null :unique :primary-key)
106 ([baz] string :not-null :unique))))))
107 (clsql:table-exists-p [foo]))
109 (clsql:drop-table [foo])
110 (clsql:table-exists-p [foo])))
113 (deftest :fddl/table/7
115 (clsql:table-exists-p [foo])
117 (let ((*backend-warning-behavior*
118 (if (member *test-database-type*
119 '(:postgresql :postgresql-socket))
122 (clsql:create-table [foo] '(([bar] integer :not-null)
123 ([baz] string :not-null))
124 :constraints '("UNIQUE (bar,baz)"
125 "PRIMARY KEY (bar)")))
126 (clsql:table-exists-p [foo]))
128 (clsql:drop-table [foo])
129 (clsql:table-exists-p [foo])))
132 (deftest :fddl/attributes/1
134 (with-dataset *ds-fddl*
136 (mapcar #'string-downcase
137 (clsql:list-attributes [alpha] :owner *test-database-user*))
141 (deftest :fddl/attributes/2
142 (with-dataset *ds-fddl*
145 (mapcar #'(lambda (a) (string-downcase (car a)))
146 (clsql:list-attribute-types [alpha]
147 :owner *test-database-user*))
151 ;; Attribute types are vendor specific so need to test a range
152 (deftest :fddl/attributes/3
153 (with-dataset *ds-fddl*
154 (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
157 (deftest :fddl/attributes/4
158 (with-dataset *ds-fddl*
159 (multiple-value-bind (type length scale nullable)
160 (clsql:attribute-type [c] [alpha])
161 (values (clsql-sys:in type :varchar :varchar2) length scale nullable)))
164 (deftest :fddl/attributes/5
165 (with-dataset *ds-fddl*
166 (and (member (clsql:attribute-type [d] [alpha]) '(:datetime :timestamp :date)) t))
169 (deftest :fddl/attributes/6
170 (with-dataset *ds-fddl*
171 (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t))
174 (deftest :fddl/attributes/7
175 (with-dataset *ds-bigint*
176 (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t))
180 ;; create a view, test for existence, drop it and test again
181 (deftest :fddl/view/1
182 (with-dataset *ds-fddl*
183 (progn (clsql:create-view [v1]
184 :as [select [a] [b] [c]
188 (clsql:view-exists-p [v1] :owner *test-database-user*)
190 (clsql:drop-view [v1] :if-does-not-exist :ignore)
191 (clsql:view-exists-p [v1] :owner *test-database-user*)))))
194 ;; create a view, list its attributes and drop it
195 (deftest :fddl/view/2
196 (with-dataset *ds-fddl*
197 (progn (clsql:create-view [v1]
198 :as [select [a] [b] [c]
202 (sort (mapcar #'string-downcase
203 (clsql:list-attributes [v1]))
205 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
208 ;; create a view, select stuff from it and drop it
209 (deftest :fddl/view/3
210 (with-dataset *ds-fddl*
212 (clsql:create-view [v1]
213 :as [select [a] [b] [c]
220 (clsql:select [a] [b] [c]
224 (car (clsql:select [a] [b] [c]
226 :where [= [a] 1])))))
228 (apply #'values result))
229 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
232 (deftest :fddl/view/4
233 (with-dataset *ds-fddl*
235 (clsql:create-view [v1]
236 :column-list '([x] [y] [z])
237 :as [select [a] [b] [c]
244 (clsql:select [x] [y] [z]
248 (car (clsql:select [x] [y] [z]
250 :where [= [x] 1])))))
252 (apply #'values result))
253 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
256 ;; create an index, test for existence, drop it and test again
257 (deftest :fddl/index/1
258 (with-dataset *ds-fddl*
259 (progn (clsql:create-index [bar] :on [alpha] :attributes
260 '([a] [b] [c]) :unique t)
262 (clsql:index-exists-p [bar] :owner *test-database-user*)
264 (clsql:drop-index [bar] :on [alpha]
265 :if-does-not-exist :ignore)
266 (clsql:index-exists-p [bar] :owner *test-database-user*)))))
269 ;; create indexes with names as strings, symbols and in square brackets
270 (deftest :fddl/index/2
271 (with-dataset *ds-fddl*
272 (let ((names '("foo" foo [foo]))
275 (clsql:create-index name :on [alpha] :attributes '([a]))
276 (push (clsql:index-exists-p name :owner *test-database-user*) result)
277 (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
278 (apply #'values result)))
281 ;; test list-indexes with keyword :ON
282 (deftest :fddl/index/3
284 (clsql:create-table [i3test] '(([a] (string 10))
286 (clsql:create-index [foo] :on [i3test] :attributes
288 (clsql:create-index [bar] :on [i3test] :attributes
291 (clsql:table-exists-p [i3test])
292 (clsql:index-exists-p [foo])
293 (clsql:index-exists-p [bar])
297 (clsql:list-indexes :on [i3test] :owner *test-database-user*))
300 (clsql:drop-index [bar] :on [i3test])
301 (clsql:drop-index [foo] :on [i3test])
302 (clsql:drop-table [i3test])
304 t t t ("bar" "foo") t)
306 ;; create an sequence, test for existence, drop it and test again
307 (deftest :fddl/sequence/1
308 (progn (clsql:create-sequence [foo])
310 (clsql:sequence-exists-p [foo] :owner *test-database-user*)
312 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
313 (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
316 ;; create and increment a sequence
317 (deftest :fddl/sequence/2
319 (clsql:create-sequence [foo])
320 (setf val1 (clsql:sequence-next [foo]))
322 (< val1 (clsql:sequence-next [foo]))
323 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
326 ;; explicitly set the value of a sequence
327 (deftest :fddl/sequence/3
329 (clsql:create-sequence [foo])
330 (clsql:set-sequence-position [foo] 5)
332 (clsql:sequence-next [foo])
333 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
338 (deftest :fddl/owner/1
339 (with-dataset *ds-fddl*
341 ;; user tables are an improper subset of all tables
342 (= (length (intersection (clsql:list-tables :owner nil)
343 (clsql:list-tables :owner :all)
345 (length (clsql:list-tables :owner nil)))
346 ;; user tables are a proper subset of all tables
347 (> (length (clsql:list-tables :owner :all))
348 (length (clsql:list-tables :owner nil)))))
351 (deftest :fddl/cache-table-queries/1
352 (with-dataset *ds-fddl*
354 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))
356 (clsql:cache-table-queries "ALPHA" :action t)
357 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))
359 (clsql:list-attribute-types "ALPHA")
364 (clsql-sys::attribute-cache clsql:*default-database*))))))
366 (clsql:cache-table-queries "ALPHA" :action :flush)
367 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))))
368 (nil (t nil) t (t nil)))
372 #.(clsql:restore-sql-reader-syntax-state)