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
28 (sort (mapcar #'string-downcase
29 (clsql:list-tables :owner *test-database-user*))
31 "addr" "company" "ea_join" "employee" "type_bigint" "type_table")
33 ;; create a table, test for its existence, drop it and test again
34 (deftest :fddl/table/2
35 (progn (clsql:create-table [foo]
39 ([comments] longchar)))
41 (clsql:table-exists-p [foo] :owner *test-database-user*)
43 (clsql:drop-table [foo] :if-does-not-exist :ignore)
44 (clsql:table-exists-p [foo] :owner *test-database-user*))))
47 ;; create a table, list its attributes and drop it
48 (deftest :fddl/table/3
50 (progn (clsql:create-table [foo]
54 ([comments] longchar)))
56 (sort (mapcar #'string-downcase
57 (clsql:list-attributes [foo]))
59 (clsql:drop-table [foo] :if-does-not-exist :ignore))))
60 "comments" "height" "id" "name")
62 (deftest :fddl/table/4
64 (clsql:table-exists-p "MyMixedCase")
66 (clsql:create-table "MyMixedCase" '(([a] integer)))
67 (clsql:table-exists-p "MyMixedCase"))
69 (clsql:drop-table "MyMixedCase")
70 (clsql:table-exists-p "MyMixedCase")))
73 (deftest :fddl/table/5
76 (clsql:create-table "MyMixedCase" '(([a] integer)))
77 (clsql:execute-command "insert into MyMixedCase values (5)")
78 (clsql:insert-records :into "MyMixedCase" :values '(6))
79 (clsql:select [a] :from "MyMixedCase" :order-by '((a :asc))))
80 (clsql:drop-table "MyMixedCase"))
83 (deftest :fddl/attributes/1
86 (mapcar #'string-downcase
87 (clsql:list-attributes [employee]
88 :owner *test-database-user*))
90 "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
91 "last_name" "managerid" "married")
93 (deftest :fddl/attributes/2
96 (mapcar #'(lambda (a) (string-downcase (car a)))
97 (clsql:list-attribute-types [employee]
98 :owner *test-database-user*))
100 "birthday" "ecompanyid" "email" "emplid" "first_name" "groupid" "height"
101 "last_name" "managerid" "married")
103 ;; Attribute types are vendor specific so need to test a range
104 (deftest :fddl/attributes/3
105 (and (member (clsql:attribute-type [emplid] [employee]) '(:int :integer :int4 :number)) t)
108 (deftest :fddl/attributes/4
109 (multiple-value-bind (type length scale nullable)
110 (clsql:attribute-type [first-name] [employee])
111 (values (clsql-sys:in type :varchar :varchar2) length scale nullable))
114 (deftest :fddl/attributes/5
115 (and (member (clsql:attribute-type [birthday] [employee]) '(:datetime :timestamp :date)) t)
118 (deftest :fddl/attributes/6
119 (and (member (clsql:attribute-type [height] [employee]) '(:float :float8 :number)) t)
124 ;; create a view, test for existence, drop it and test again
125 (deftest :fddl/view/1
126 (progn (clsql:create-view [lenins-group]
127 :as [select [first-name] [last-name] [email]
129 :where [= [managerid] 1]])
131 (clsql:view-exists-p [lenins-group] :owner *test-database-user*)
133 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
134 (clsql:view-exists-p [lenins-group] :owner *test-database-user*))))
137 ;; create a view, list its attributes and drop it
138 (when (clsql-sys:db-type-has-views? *test-database-underlying-type*)
139 (deftest :fddl/view/2
140 (progn (clsql:create-view [lenins-group]
141 :as [select [first-name] [last-name] [email]
143 :where [= [managerid] 1]])
145 (sort (mapcar #'string-downcase
146 (clsql:list-attributes [lenins-group]))
148 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)))
149 ("email" "first_name" "last_name")))
151 ;; create a view, select stuff from it and drop it
152 (deftest :fddl/view/3
153 (progn (clsql:create-view [lenins-group]
154 :as [select [first-name] [last-name] [email]
156 :where [= [managerid] 1]])
160 (clsql:select [first-name] [last-name] [email]
162 :where [= [last-name] "Lenin"])
164 (car (clsql:select [first-name] [last-name] [email]
166 :where [= [last-name] "Stalin"])))))
167 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
168 (apply #'values result)))
169 nil ("Josef" "Stalin" "stalin@soviet.org"))
171 (deftest :fddl/view/4
172 (progn (clsql:create-view [lenins-group]
173 :column-list '([forename] [surname] [email])
174 :as [select [first-name] [last-name] [email]
176 :where [= [managerid] 1]])
180 (clsql:select [forename] [surname] [email]
182 :where [= [surname] "Lenin"])
184 (car (clsql:select [forename] [surname] [email]
186 :where [= [surname] "Stalin"])))))
187 (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
188 (apply #'values result)))
189 nil ("Josef" "Stalin" "stalin@soviet.org"))
191 ;; create an index, test for existence, drop it and test again
192 (deftest :fddl/index/1
193 (progn (clsql:create-index [bar] :on [employee] :attributes
194 '([first-name] [last-name] [email]) :unique t)
196 (clsql:index-exists-p [bar] :owner *test-database-user*)
198 (clsql:drop-index [bar] :on [employee]
199 :if-does-not-exist :ignore)
200 (clsql:index-exists-p [bar] :owner *test-database-user*))))
203 ;; create indexes with names as strings, symbols and in square brackets
204 (deftest :fddl/index/2
205 (let ((names '("foo" foo [foo]))
208 (clsql:create-index name :on [employee] :attributes '([emplid]))
209 (push (clsql:index-exists-p name :owner *test-database-user*) result)
210 (clsql:drop-index name :on [employee] :if-does-not-exist :ignore))
211 (apply #'values result))
214 ;; test list-table-indexes
215 (deftest :fddl/index/3
217 (clsql:create-table [i3test] '(([a] (string 10))
219 (clsql:create-index [foo] :on [i3test] :attributes
221 (clsql:create-index [bar] :on [i3test] :attributes
224 (clsql:table-exists-p [i3test])
225 (clsql:index-exists-p [foo])
226 (clsql:index-exists-p [bar])
230 (clsql:list-table-indexes [i3test] :owner *test-database-user*))
233 (clsql:drop-index [bar] :on [i3test])
234 (clsql:drop-index [foo] :on [i3test])
235 (clsql:drop-table [i3test])
237 t t t ("bar" "foo") t)
239 ;; create an sequence, test for existence, drop it and test again
240 (deftest :fddl/sequence/1
241 (progn (clsql:create-sequence [foo])
243 (clsql:sequence-exists-p [foo] :owner *test-database-user*)
245 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
246 (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
249 ;; create and increment a sequence
250 (deftest :fddl/sequence/2
252 (clsql:create-sequence [foo])
253 (setf val1 (clsql:sequence-next [foo]))
255 (< val1 (clsql:sequence-next [foo]))
256 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
259 ;; explicitly set the value of a sequence
260 (deftest :fddl/sequence/3
262 (clsql:create-sequence [foo])
263 (clsql:set-sequence-position [foo] 5)
265 (clsql:sequence-next [foo])
266 (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
271 #.(clsql:restore-sql-reader-syntax-state)