1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-init.lisp
4 ;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
5 ;;;; Created: 30/03/2004
6 ;;;; Updated: <04/04/2004 12:14:38 marcusp>
7 ;;;; ======================================================================
9 ;;;; Description ==========================================================
10 ;;;; ======================================================================
12 ;;;; Initialisation utilities for running regression tests on CLSQL-USQL.
14 ;;;; ======================================================================
16 (in-package :clsql-usql-tests)
18 (defvar *test-database-type* nil)
19 (defvar *test-database-server* "")
20 (defvar *test-database-name* "")
21 (defvar *test-database-user* "")
22 (defvar *test-database-password* "")
25 ((extraterrestrial :initform nil :initarg :extraterrestrial)))
27 (def-view-class person (thing)
28 ((height :db-kind :base :accessor height :type float :nulls-ok t
30 (married :db-kind :base :accessor married :type boolean :nulls-ok t
32 (birthday :nulls-ok t :type wall-time :initarg :birthday)
33 (hobby :db-kind :virtual :initarg :hobby :initform nil)))
35 (def-view-class employee (person)
38 :db-constraints :not-null
44 :db-constraints :not-null
57 :accessor employee-email
64 :accessor employee-company
66 :db-info (:join-class company
68 :foreign-key companyid
74 :accessor employee-manager
76 :db-info (:join-class employee
80 (:base-table employee))
82 (def-view-class company ()
85 :db-constraints :not-null
90 :db-constraints :not-null
101 :db-info (:join-class employee
102 :home-key presidentid
106 :reader company-employees
108 :db-info (:join-class employee
109 :home-key (companyid groupid)
110 :foreign-key (companyid groupid)
112 (:base-table company))
114 (defparameter company1 (make-instance 'company
117 :name "Widgets Inc."))
119 (defparameter employee1 (make-instance 'employee
123 :height (1+ (random 1.00))
124 :birthday (usql:get-time)
125 :first-name "Vladamir"
127 :email "lenin@soviet.org"))
129 (defparameter employee2 (make-instance 'employee
132 :height (1+ (random 1.00))
134 :birthday (usql:get-time)
137 :email "stalin@soviet.org"))
139 (defparameter employee3 (make-instance 'employee
142 :height (1+ (random 1.00))
144 :birthday (usql:get-time)
147 :email "trotsky@soviet.org"))
149 (defparameter employee4 (make-instance 'employee
152 :height (1+ (random 1.00))
154 :birthday (usql:get-time)
156 :last-name "Kruschev"
157 :email "kruschev@soviet.org"))
159 (defparameter employee5 (make-instance 'employee
163 :height (1+ (random 1.00))
164 :birthday (usql:get-time)
166 :last-name "Brezhnev"
167 :email "brezhnev@soviet.org"))
169 (defparameter employee6 (make-instance 'employee
173 :height (1+ (random 1.00))
174 :birthday (usql:get-time)
176 :last-name "Andropov"
177 :email "andropov@soviet.org"))
179 (defparameter employee7 (make-instance 'employee
182 :height (1+ (random 1.00))
184 :birthday (usql:get-time)
185 :first-name "Konstantin"
186 :last-name "Chernenko"
187 :email "chernenko@soviet.org"))
189 (defparameter employee8 (make-instance 'employee
192 :height (1+ (random 1.00))
194 :birthday (usql:get-time)
195 :first-name "Mikhail"
196 :last-name "Gorbachev"
197 :email "gorbachev@soviet.org"))
199 (defparameter employee9 (make-instance 'employee
203 :height (1+ (random 1.00))
204 :birthday (usql:get-time)
207 :email "yeltsin@soviet.org"))
209 (defparameter employee10 (make-instance 'employee
213 :height (1+ (random 1.00))
214 :birthday (usql:get-time)
215 :first-name "Vladamir"
217 :email "putin@soviet.org"))
219 (defun test-database-connection-spec ()
220 (let ((dbserver *test-database-server*)
221 (dbname *test-database-name*)
222 (dbpassword *test-database-password*)
223 (dbtype *test-database-type*)
224 (username *test-database-user*))
227 `("" ,dbname ,username ,dbpassword))
229 `(,dbserver ,dbname ,username ,dbpassword))
231 `("" ,dbname ,username ,dbpassword))
235 `(,username ,dbpassword ,dbname))
237 (error "Unrecognized database type: ~A" dbtype)))))
239 (defun test-connect-to-database (database-type)
240 (setf *test-database-type* database-type)
241 ;; Connect to the database
242 (usql:connect (test-database-connection-spec)
243 :database-type database-type
247 (defun test-initialise-database ()
248 ;; Delete the instance records
250 (usql:delete-instance-records company1)
251 (usql:delete-instance-records employee1)
252 (usql:delete-instance-records employee2)
253 (usql:delete-instance-records employee3)
254 (usql:delete-instance-records employee4)
255 (usql:delete-instance-records employee5)
256 (usql:delete-instance-records employee6)
257 (usql:delete-instance-records employee7)
258 (usql:delete-instance-records employee8)
259 (usql:delete-instance-records employee9)
260 (usql:delete-instance-records employee10)
261 ;; Drop the required tables if they exist
262 (usql:drop-view-from-class 'employee)
263 (usql:drop-view-from-class 'company))
264 ;; Create the tables for our view classes
265 (usql:create-view-from-class 'employee)
266 (usql:create-view-from-class 'company)
267 ;; Lenin manages everyone
268 (usql:add-to-relation employee2 'manager employee1)
269 (usql:add-to-relation employee3 'manager employee1)
270 (usql:add-to-relation employee4 'manager employee1)
271 (usql:add-to-relation employee5 'manager employee1)
272 (usql:add-to-relation employee6 'manager employee1)
273 (usql:add-to-relation employee7 'manager employee1)
274 (usql:add-to-relation employee8 'manager employee1)
275 (usql:add-to-relation employee9 'manager employee1)
276 (usql:add-to-relation employee10 'manager employee1)
277 ;; Everyone works for Widgets Inc.
278 (usql:add-to-relation company1 'employees employee1)
279 (usql:add-to-relation company1 'employees employee2)
280 (usql:add-to-relation company1 'employees employee3)
281 (usql:add-to-relation company1 'employees employee4)
282 (usql:add-to-relation company1 'employees employee5)
283 (usql:add-to-relation company1 'employees employee6)
284 (usql:add-to-relation company1 'employees employee7)
285 (usql:add-to-relation company1 'employees employee8)
286 (usql:add-to-relation company1 'employees employee9)
287 (usql:add-to-relation company1 'employees employee10)
288 ;; Lenin is president of Widgets Inc.
289 (usql:add-to-relation company1 'president employee1)
290 ;; store these instances
291 (usql:update-records-from-instance employee1)
292 (usql:update-records-from-instance employee2)
293 (usql:update-records-from-instance employee3)
294 (usql:update-records-from-instance employee4)
295 (usql:update-records-from-instance employee5)
296 (usql:update-records-from-instance employee6)
297 (usql:update-records-from-instance employee7)
298 (usql:update-records-from-instance employee8)
299 (usql:update-records-from-instance employee9)
300 (usql:update-records-from-instance employee10)
301 (usql:update-records-from-instance company1))
303 (defun test-usql (backend)
304 (format t "~&Running CLSQL-USQL tests with ~A backend.~%" backend)
305 (test-connect-to-database backend)
306 (test-initialise-database)