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*
24 (create-table [alpha] '(([a] integer)
28 (create-table [bravo] '(([foo] integer)
30 (:sqldata "ALPHA" "A,C,D,F"
31 "1,'asdf','2010-01-01',3.14"
32 "2,'blarg','2012-12-21',0.1"
33 "3,'matey','1992-02-29',0.0")
34 (:cleanup "DROP TABLE ALPHA" "DROP TABLE BRAVO"))
39 ;; list current tables
40 (deftest :fddl/table/1
41 (with-dataset *ds-fddl*
42 (sort (mapcar #'string-downcase
43 (clsql:list-tables :owner *test-database-user*))
47 ;; create a table, test for its existence, drop it and test again
48 (deftest :fddl/table/2
49 (progn (clsql:create-table [foo]
53 ([comments] longchar)))
55 (clsql:table-exists-p [foo] :owner *test-database-user*)
57 (clsql:drop-table [foo] :if-does-not-exist :ignore)
58 (clsql:table-exists-p [foo] :owner *test-database-user*))))
61 ;; create a table, list its attributes and drop it
62 (deftest :fddl/table/3
64 (progn (clsql:create-table [foo]
68 ([comments] longchar)))
70 (sort (mapcar #'string-downcase
71 (clsql:list-attributes [foo]))
73 (clsql:drop-table [foo] :if-does-not-exist :ignore))))
74 "comments" "height" "id" "name")
76 (deftest :fddl/table/4
78 (clsql:table-exists-p "MyMixedCase")
80 (clsql:create-table "MyMixedCase" '(([a] integer)))
81 (clsql:table-exists-p "MyMixedCase"))
83 (clsql:drop-table "MyMixedCase")
84 (clsql:table-exists-p "MyMixedCase")))
87 (deftest :fddl/table/5
90 (clsql:create-table "MyMixedCase" '(([a] integer)))
91 (clsql:execute-command "insert into \"MyMixedCase\" values (5)")
92 (clsql:insert-records :into "MyMixedCase" :values '(6))
93 (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
94 (clsql:drop-table "MyMixedCase"))
97 (deftest :fddl/table/6
99 (clsql:table-exists-p [foo])
101 (let ((*backend-warning-behavior*
102 (if (member *test-database-type*
103 '(:postgresql :postgresql-socket))
106 (case *test-database-underlying-type*
107 (:mssql (clsql:create-table [foo]
108 '(([bar] integer :not-null :primary-key)
109 ([baz] string :not-null :unique))))
110 (t (clsql:create-table [foo]
111 '(([bar] integer :not-null :unique :primary-key)
112 ([baz] string :not-null :unique))))))
113 (clsql:table-exists-p [foo]))
115 (clsql:drop-table [foo])
116 (clsql:table-exists-p [foo])))
119 (deftest :fddl/table/7
121 (clsql:table-exists-p [foo])
123 (let ((*backend-warning-behavior*
124 (if (member *test-database-type*
125 '(:postgresql :postgresql-socket))
128 (clsql:create-table [foo] '(([bar] integer :not-null)
129 ([baz] string :not-null))
130 :constraints '("UNIQUE (bar,baz)"
131 "PRIMARY KEY (bar)")))
132 (clsql:table-exists-p [foo]))
134 (clsql:drop-table [foo])
135 (clsql:table-exists-p [foo])))
138 (deftest :fddl/attributes/1
140 (with-dataset *ds-fddl*
142 (mapcar #'string-downcase
143 (clsql:list-attributes [alpha] :owner *test-database-user*))
147 (deftest :fddl/attributes/2
148 (with-dataset *ds-fddl*
151 (mapcar #'(lambda (a) (string-downcase (car a)))
152 (clsql:list-attribute-types [alpha]
153 :owner *test-database-user*))
157 ;; Attribute types are vendor specific so need to test a range
158 (deftest :fddl/attributes/3
159 (with-dataset *ds-fddl*
160 (and (member (clsql:attribute-type [a] [alpha]) '(:int :integer :int4 :number)) t))
163 (deftest :fddl/attributes/4
164 (with-dataset *ds-fddl*
165 (multiple-value-bind (type length scale nullable)
166 (clsql:attribute-type [c] [alpha])
167 (values (clsql-sys:in type :varchar :varchar2) length scale nullable)))
170 (deftest :fddl/attributes/5
171 (with-dataset *ds-fddl*
172 (and (member (clsql:attribute-type [d] [alpha]) '(:datetime :timestamp :date)) t))
175 (deftest :fddl/attributes/6
176 (with-dataset *ds-fddl*
177 (and (member (clsql:attribute-type [f] [alpha]) '(:float :float8 :number)) t))
180 (deftest :fddl/attributes/7
181 (with-dataset *ds-bigint*
182 (and (member (clsql:attribute-type [t_bigint] [TYPE_BIGINT]) '(:bigint :int8)) t))
186 ;; create a view, test for existence, drop it and test again
187 (deftest :fddl/view/1
188 (with-dataset *ds-fddl*
189 (progn (clsql:create-view [v1]
190 :as [select [a] [c] [d]
194 (clsql:view-exists-p [v1])
196 (clsql:drop-view [v1] :if-does-not-exist :ignore)
197 (clsql:view-exists-p [v1])))))
200 ;; create a view, list its attributes and drop it
201 (deftest :fddl/view/2
202 (with-dataset *ds-fddl*
203 (progn (clsql:create-view [v1]
204 :as [select [a] [c] [d]
208 (sort (mapcar #'string-downcase
209 (clsql:list-attributes [v1]))
211 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
214 ;; create a view, select stuff from it and drop it
215 (deftest :fddl/view/3
216 (with-dataset *ds-fddl*
218 (clsql:create-view [v1]
219 :as [select [a] [c] [d]
226 (clsql:select [a] [c]
230 (car (clsql:select [a] [c]
232 :where [= [a] 1])))))
234 (apply #'values result))
235 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
238 (deftest :fddl/view/4
239 (with-dataset *ds-fddl*
241 (clsql:create-view [v1]
242 :column-list '([x] [y] [z])
243 :as [select [a] [c] [d]
249 (sort (mapcar #'string-downcase
250 (clsql:list-attributes [v1]))
253 (clsql:select [x] [y]
257 (car (clsql:select [x] [y]
259 :where [= [x] 1])))))
261 (apply #'values result))
262 (clsql:drop-view [v1] :if-does-not-exist :ignore))))
263 ("x" "y" "z") nil (1 "asdf"))
265 ;; create an index, test for existence, drop it and test again
266 (deftest :fddl/index/1
267 (with-dataset *ds-fddl*
268 (progn (clsql:create-index [bar] :on [alpha] :attributes
269 '([a] [c]) :unique t)
271 (clsql:index-exists-p [bar] :owner *test-database-user*)
273 (clsql:drop-index [bar] :on [alpha]
274 :if-does-not-exist :ignore)
275 (clsql:index-exists-p [bar] :owner *test-database-user*)))))
278 ;; create indexes with names as strings, symbols and in square brackets
279 (deftest :fddl/index/2
280 (with-dataset *ds-fddl*
281 (let ((names '("foo" foo [foo]))
284 (clsql:create-index name :on [alpha] :attributes '([a]))
285 (push (clsql:index-exists-p name :owner *test-database-user*) result)
286 (clsql:drop-index name :on [alpha] :if-does-not-exist :ignore))
287 (apply #'values result)))
290 ;; test list-indexes with keyword :ON
291 (deftest :fddl/index/3
293 (clsql:create-table [i3test] '(([a] (string 10))
295 (clsql:create-index [foo] :on [i3test] :attributes
297 (clsql:create-index [bar] :on [i3test] :attributes
300 (clsql:table-exists-p [i3test])
301 (clsql:index-exists-p [foo])
302 (clsql:index-exists-p [bar])
306 (clsql:list-indexes :on [i3test] :owner *test-database-user*))
309 (clsql:drop-index [bar] :on [i3test])
310 (clsql:drop-index [foo] :on [i3test])
311 (clsql:drop-table [i3test])
313 t t t ("bar" "foo") t)
315 ;; create an sequence, test for existence, drop it and test again
316 (deftest :fddl/sequence/1
317 (progn (clsql:create-sequence [foo])
319 (clsql:sequence-exists-p [foo] :owner *test-database-user*)
321 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
322 (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
325 ;; create and increment a sequence
326 (deftest :fddl/sequence/2
328 (clsql:create-sequence [foo])
329 (setf val1 (clsql:sequence-next [foo]))
331 (< val1 (clsql:sequence-next [foo]))
332 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
335 ;; explicitly set the value of a sequence
336 (deftest :fddl/sequence/3
338 (clsql:create-sequence [foo])
339 (clsql:set-sequence-position [foo] 5)
341 (clsql:sequence-next [foo])
342 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
347 (deftest :fddl/owner/1
348 (with-dataset *ds-fddl*
350 ;; user tables are an improper subset of all tables
351 (= (length (intersection (clsql:list-tables :owner nil)
352 (clsql:list-tables :owner :all)
354 (length (clsql:list-tables :owner nil)))
355 ;; user tables are a proper subset of all tables
356 (> (length (clsql:list-tables :owner :all))
357 (length (clsql:list-tables :owner nil)))))
360 (deftest :fddl/cache-table-queries/1
361 (with-dataset *ds-fddl*
363 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*))
365 (clsql:cache-table-queries "ALPHA" :action t)
366 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))
368 (clsql:list-attribute-types "ALPHA")
373 (clsql-sys::attribute-cache clsql:*default-database*))))))
375 (clsql:cache-table-queries "ALPHA" :action :flush)
376 (gethash "ALPHA" (clsql-sys::attribute-cache clsql:*default-database*)))))
377 (nil (t nil) t (t nil)))
381 #.(clsql:restore-sql-reader-syntax-state)