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
7 ;;;; ======================================================================
9 ;;;; Description ==========================================================
10 ;;;; ======================================================================
12 ;;;; Initialisation utilities for running regression tests on CLSQL.
14 ;;;; ======================================================================
16 (in-package #:clsql-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 clsql-base: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 (clsql-base: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 (clsql-base:get-time)
137 :email "stalin@soviet.org"))
139 (defparameter employee3 (make-instance 'employee
142 :height (1+ (random 1.00))
144 :birthday (clsql-base:get-time)
147 :email "trotsky@soviet.org"))
149 (defparameter employee4 (make-instance 'employee
152 :height (1+ (random 1.00))
154 :birthday (clsql-base: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 (clsql-base: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 (clsql-base: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 (clsql-base: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 (clsql-base: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 (clsql-base:get-time)
207 :email "yeltsin@soviet.org"))
209 (defparameter employee10 (make-instance 'employee
213 :height (1+ (random 1.00))
214 :birthday (clsql-base: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 (clsql:connect (test-database-connection-spec)
243 :database-type database-type
247 (defmacro with-ignore-errors (&rest forms)
250 (lambda (x) (list 'ignore-errors x))
253 (defun test-initialise-database ()
254 ;; Delete the instance records
256 (clsql:delete-instance-records company1)
257 (clsql:delete-instance-records employee1)
258 (clsql:delete-instance-records employee2)
259 (clsql:delete-instance-records employee3)
260 (clsql:delete-instance-records employee4)
261 (clsql:delete-instance-records employee5)
262 (clsql:delete-instance-records employee6)
263 (clsql:delete-instance-records employee7)
264 (clsql:delete-instance-records employee8)
265 (clsql:delete-instance-records employee9)
266 (clsql:delete-instance-records employee10)
267 ;; Drop the required tables if they exist
268 (clsql:drop-view-from-class 'employee)
269 (clsql:drop-view-from-class 'company))
270 ;; Create the tables for our view classes
271 (clsql:create-view-from-class 'employee)
272 (clsql:create-view-from-class 'company)
273 ;; Lenin manages everyone
274 (clsql:add-to-relation employee2 'manager employee1)
275 (clsql:add-to-relation employee3 'manager employee1)
276 (clsql:add-to-relation employee4 'manager employee1)
277 (clsql:add-to-relation employee5 'manager employee1)
278 (clsql:add-to-relation employee6 'manager employee1)
279 (clsql:add-to-relation employee7 'manager employee1)
280 (clsql:add-to-relation employee8 'manager employee1)
281 (clsql:add-to-relation employee9 'manager employee1)
282 (clsql:add-to-relation employee10 'manager employee1)
283 ;; Everyone works for Widgets Inc.
284 (clsql:add-to-relation company1 'employees employee1)
285 (clsql:add-to-relation company1 'employees employee2)
286 (clsql:add-to-relation company1 'employees employee3)
287 (clsql:add-to-relation company1 'employees employee4)
288 (clsql:add-to-relation company1 'employees employee5)
289 (clsql:add-to-relation company1 'employees employee6)
290 (clsql:add-to-relation company1 'employees employee7)
291 (clsql:add-to-relation company1 'employees employee8)
292 (clsql:add-to-relation company1 'employees employee9)
293 (clsql:add-to-relation company1 'employees employee10)
294 ;; Lenin is president of Widgets Inc.
295 (clsql:add-to-relation company1 'president employee1)
296 ;; store these instances
297 (clsql:update-records-from-instance employee1)
298 (clsql:update-records-from-instance employee2)
299 (clsql:update-records-from-instance employee3)
300 (clsql:update-records-from-instance employee4)
301 (clsql:update-records-from-instance employee5)
302 (clsql:update-records-from-instance employee6)
303 (clsql:update-records-from-instance employee7)
304 (clsql:update-records-from-instance employee8)
305 (clsql:update-records-from-instance employee9)
306 (clsql:update-records-from-instance employee10)
307 (clsql:update-records-from-instance company1))
309 (defun run-tests (backend)
310 (format t "~&Running CLSQL tests with ~A backend.~%" backend)
311 (test-connect-to-database backend)
312 (test-initialise-database)