1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-init.lisp
4 ;;;; Authors: Marcus Pearce <m.t.pearce@city.ac.uk>, Kevin Rosenberg
5 ;;;; Created: 30/03/2004
8 ;;;; Initialisation utilities for running regression tests on CLSQL.
10 ;;;; ======================================================================
12 (in-package #:clsql-tests)
14 (defvar *rt-connection*)
21 (defvar *test-database-type* nil)
22 (defvar *test-database-user* nil)
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-connect-to-database (database-type spec)
220 (setf *test-database-type* database-type)
221 (when (>= (length spec) 3)
222 (setq *test-database-user* (third spec)))
224 ;; Connect to the database
226 :database-type database-type
230 (defmacro with-ignore-errors (&rest forms)
233 (lambda (x) (list 'ignore-errors x))
236 (defun test-initialise-database ()
237 ;; Delete the instance records
239 (clsql:delete-instance-records company1)
240 (clsql:delete-instance-records employee1)
241 (clsql:delete-instance-records employee2)
242 (clsql:delete-instance-records employee3)
243 (clsql:delete-instance-records employee4)
244 (clsql:delete-instance-records employee5)
245 (clsql:delete-instance-records employee6)
246 (clsql:delete-instance-records employee7)
247 (clsql:delete-instance-records employee8)
248 (clsql:delete-instance-records employee9)
249 (clsql:delete-instance-records employee10)
250 ;; Drop the required tables if they exist
251 (clsql:drop-view-from-class 'employee)
252 (clsql:drop-view-from-class 'company))
253 ;; Create the tables for our view classes
254 (clsql:create-view-from-class 'employee)
255 (clsql:create-view-from-class 'company)
256 ;; Lenin manages everyone
257 (clsql:add-to-relation employee2 'manager employee1)
258 (clsql:add-to-relation employee3 'manager employee1)
259 (clsql:add-to-relation employee4 'manager employee1)
260 (clsql:add-to-relation employee5 'manager employee1)
261 (clsql:add-to-relation employee6 'manager employee1)
262 (clsql:add-to-relation employee7 'manager employee1)
263 (clsql:add-to-relation employee8 'manager employee1)
264 (clsql:add-to-relation employee9 'manager employee1)
265 (clsql:add-to-relation employee10 'manager employee1)
266 ;; Everyone works for Widgets Inc.
267 (clsql:add-to-relation company1 'employees employee1)
268 (clsql:add-to-relation company1 'employees employee2)
269 (clsql:add-to-relation company1 'employees employee3)
270 (clsql:add-to-relation company1 'employees employee4)
271 (clsql:add-to-relation company1 'employees employee5)
272 (clsql:add-to-relation company1 'employees employee6)
273 (clsql:add-to-relation company1 'employees employee7)
274 (clsql:add-to-relation company1 'employees employee8)
275 (clsql:add-to-relation company1 'employees employee9)
276 (clsql:add-to-relation company1 'employees employee10)
277 ;; Lenin is president of Widgets Inc.
278 (clsql:add-to-relation company1 'president employee1)
279 ;; store these instances
280 (clsql:update-records-from-instance employee1)
281 (clsql:update-records-from-instance employee2)
282 (clsql:update-records-from-instance employee3)
283 (clsql:update-records-from-instance employee4)
284 (clsql:update-records-from-instance employee5)
285 (clsql:update-records-from-instance employee6)
286 (clsql:update-records-from-instance employee7)
287 (clsql:update-records-from-instance employee8)
288 (clsql:update-records-from-instance employee9)
289 (clsql:update-records-from-instance employee10)
290 (clsql:update-records-from-instance company1))
293 (let ((specs (read-specs)))
295 (warn "Not running tests because test configuration file is missing")
296 (return-from run-tests :skipped))
297 (load-necessary-systems specs)
298 (dolist (db-type +all-db-types+)
299 (let ((spec (db-type-spec db-type specs)))
301 (do-tests-for-backend spec db-type))))))
303 (defun load-necessary-systems (specs)
304 (dolist (db-type +all-db-types+)
305 (when (db-type-spec db-type specs)
306 (db-type-ensure-system db-type))))
308 (defun do-tests-for-backend (spec db-type)
311 *******************************************************************
312 *** Running CLSQL tests with ~A backend.
313 *******************************************************************
315 (regression-test:rem-all-tests)
317 ;; Tests of clsql-base
318 (ignore-errors (destroy-database spec :database-type db-type))
319 (ignore-errors (create-database spec :database-type db-type))
320 (with-tests (:name "CLSQL")
321 (test-basic spec db-type))
323 (ignore-errors (destroy-database spec :database-type db-type))
324 (ignore-errors (create-database spec :database-type db-type))
325 (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml*
326 *rt-ooddl* *rt-oodml* *rt-syntax*))
328 (test-connect-to-database db-type spec)
329 (test-initialise-database)