r9119: Automated commit for Debian build of clsql upstream-version-2.9.2
[clsql.git] / tests / test-fddl.lisp
1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File:    test-fddl.lisp
4 ;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>
5 ;;;; Created: 30/03/2004
6 ;;;; Updated: $Id$
7 ;;;;
8 ;;;; Tests for the CLSQL Functional Data Definition Language
9 ;;;; (FDDL).
10 ;;;;
11 ;;;; This file is part of CLSQL.
12 ;;;;
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 ;;;; ======================================================================
17
18 (in-package #:clsql-tests)
19
20 #.(clsql:locally-enable-sql-reader-syntax)
21
22 (setq *rt-fddl*
23       '(
24         
25 ;; list current tables 
26 (deftest :fddl/table/1
27     (apply #'values 
28            (sort (mapcar #'string-downcase
29                          (clsql:list-tables :owner *test-database-user*))
30                  #'string>))
31   "employee" "company")
32
33 ;; create a table, test for its existence, drop it and test again 
34 (deftest :fddl/table/2
35     (progn (clsql:create-table  [foo]
36                                '(([id] integer)
37                                  ([height] float)
38                                  ([name] (string 24))
39                                  ([comments] longchar)))
40            (values
41             (clsql:table-exists-p [foo] :owner *test-database-user*)
42             (progn
43               (clsql:drop-table [foo] :if-does-not-exist :ignore)
44               (clsql:table-exists-p [foo] :owner *test-database-user*))))
45   t nil)
46
47 ;; create a table, list its attributes and drop it 
48 (deftest :fddl/table/3
49     (apply #'values 
50            (progn (clsql:create-table  [foo]
51                                       '(([id] integer)
52                                         ([height] float)
53                                         ([name] (char 255))
54                                         ([comments] longchar)))
55                   (prog1
56                       (sort (mapcar #'string-downcase
57                                     (clsql:list-attributes [foo]))
58                             #'string<)
59                     (clsql:drop-table [foo] :if-does-not-exist :ignore))))
60   "comments" "height" "id" "name")
61
62 (deftest :fddl/attributes/1
63     (apply #'values
64            (sort 
65             (mapcar #'string-downcase
66                     (clsql:list-attributes [employee]
67                                           :owner *test-database-user*))
68             #'string<))
69   "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
70   "last_name" "managerid" "married")
71
72 (deftest :fddl/attributes/2
73     (apply #'values 
74            (sort 
75             (mapcar #'(lambda (a) (string-downcase (car a)))
76                     (clsql:list-attribute-types [employee]
77                                                :owner *test-database-user*))
78             #'string<))
79   "birthday" "companyid" "email" "emplid" "first_name" "groupid" "height"
80   "last_name" "managerid" "married")
81
82 ;; create a view, test for existence, drop it and test again
83 (deftest :fddl/view/1
84     (progn (clsql:create-view [lenins-group]
85                               :as [select [first-name] [last-name] [email]
86                                           :from [employee]
87                                           :where [= [managerid] 1]])
88            (values  
89             (clsql:view-exists-p [lenins-group] :owner *test-database-user*)
90             (progn
91               (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
92               (clsql:view-exists-p [lenins-group] :owner *test-database-user*))))
93   t nil)
94   
95   ;; create a view, list its attributes and drop it 
96 (when (clsql-base-sys:db-type-has-views? *test-database-underlying-type*)
97   (deftest :fddl/view/2
98       (progn (clsql:create-view [lenins-group]
99                                 :as [select [first-name] [last-name] [email]
100                                             :from [employee]
101                                             :where [= [managerid] 1]])
102              (prog1
103                  (sort (mapcar #'string-downcase
104                                (clsql:list-attributes [lenins-group]))
105                        #'string<)
106                (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)))
107     ("email" "first_name" "last_name")))
108   
109   ;; create a view, select stuff from it and drop it 
110 (deftest :fddl/view/3
111     (progn (clsql:create-view [lenins-group]
112                               :as [select [first-name] [last-name] [email]
113                                           :from [employee]
114                                           :where [= [managerid] 1]])
115            (let ((result 
116                   (list 
117                    ;; Shouldn't exist 
118                    (clsql:select [first-name] [last-name] [email]
119                                  :from [lenins-group]
120                                  :where [= [last-name] "Lenin"])
121                    ;; Should exist 
122                    (car (clsql:select [first-name] [last-name] [email]
123                                       :from [lenins-group]
124                                       :where [= [last-name] "Stalin"])))))
125              (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
126              (apply #'values result)))
127   nil ("Josef" "Stalin" "stalin@soviet.org"))
128   
129 (deftest :fddl/view/4
130     (progn (clsql:create-view [lenins-group]
131                               :column-list '([forename] [surname] [email])
132                               :as [select [first-name] [last-name] [email]
133                                           :from [employee]
134                                           :where [= [managerid] 1]])
135            (let ((result 
136                   (list
137                    ;; Shouldn't exist 
138                    (clsql:select [forename] [surname] [email]
139                                  :from [lenins-group]
140                                  :where [= [surname] "Lenin"])
141                    ;; Should exist 
142                    (car (clsql:select [forename] [surname] [email]
143                                       :from [lenins-group]
144                                       :where [= [surname] "Stalin"])))))
145              (clsql:drop-view [lenins-group] :if-does-not-exist :ignore)
146              (apply #'values result)))
147   nil ("Josef" "Stalin" "stalin@soviet.org"))
148
149 ;; create an index, test for existence, drop it and test again 
150 (deftest :fddl/index/1
151     (progn (clsql:create-index [bar] :on [employee] :attributes
152                               '([first-name] [last-name] [email]) :unique t)
153            (values
154             (clsql:index-exists-p [bar] :owner *test-database-user*)
155             (progn
156               (clsql:drop-index [bar] :on [employee]
157                                 :if-does-not-exist :ignore)
158               (clsql:index-exists-p [bar] :owner *test-database-user*))))
159   t nil)
160
161 ;; create indexes with names as strings, symbols and in square brackets 
162 (deftest :fddl/index/2
163     (let ((names '("foo" foo [foo]))
164           (result '()))
165       (dolist (name names)
166         (clsql:create-index name :on [employee] :attributes '([emplid]))
167         (push (clsql:index-exists-p name :owner *test-database-user*) result)
168         (clsql:drop-index name :on [employee] :if-does-not-exist :ignore))
169       (apply #'values result))
170   t t t)
171
172 ;; test list-table-indexes
173 (deftest :fddl/index/3
174     (progn
175       (clsql:execute-command "CREATE TABLE I3TEST (a char(10), b integer)")
176       (clsql:create-index [bar] :on [i3test] :attributes
177                           '([a]) :unique t)
178       (clsql:create-index [foo] :on [i3test] :attributes
179                           '([b]) :unique nil)
180       (values
181        
182        (sort 
183         (mapcar 
184          #'string-downcase
185          (clsql:list-table-indexes [i3test] :owner *test-database-user*))
186             #'string-lessp)
187        (sort (clsql:list-table-indexes [company] :owner *test-database-user*)
188              #'string-lessp)
189        (progn
190          (clsql:drop-index [bar] :on [i3test])
191          (clsql:drop-index [foo] :on [i3test])
192          (clsql:execute-command "DROP TABLE I3TEST")
193          t)))
194   ("bar" "foo") nil t)
195
196 ;; create an sequence, test for existence, drop it and test again 
197 (deftest :fddl/sequence/1
198     (progn (clsql:create-sequence [foo])
199            (values
200             (clsql:sequence-exists-p [foo] :owner *test-database-user*)
201             (progn
202               (clsql:drop-sequence [foo] :if-does-not-exist :ignore)
203               (clsql:sequence-exists-p [foo] :owner *test-database-user*))))
204   t nil)
205
206 ;; create and increment a sequence
207 (deftest :fddl/sequence/2
208     (let ((val1 nil))
209       (clsql:create-sequence [foo])
210       (setf val1 (clsql:sequence-next [foo]))
211       (prog1
212           (< val1 (clsql:sequence-next [foo]))
213         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
214   t)
215
216 ;; explicitly set the value of a sequence
217 (deftest :fddl/sequence/3
218     (progn
219       (clsql:create-sequence [foo])
220       (clsql:set-sequence-position [foo] 5)
221       (prog1
222           (clsql:sequence-next [foo])
223         (clsql:drop-sequence [foo] :if-does-not-exist :ignore)))
224   6)
225
226 ))
227
228 #.(clsql:restore-sql-reader-syntax-state)