X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=db217ecae06e1bffe78612affded35020a90e5d9;hp=33349084864afe13b0fa4027e650c1d4c941d678;hb=fa32c4233b4a02ae631602dbb0a234ab10df8aaf;hpb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 3334908..db217ec 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -1,25 +1,25 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ====================================================================== ;;;; File: test-init.lisp -;;;; Author: Marcus Pearce +;;;; Authors: Marcus Pearce , Kevin Rosenberg ;;;; Created: 30/03/2004 -;;;; Updated: <04/04/2004 12:14:38 marcusp> -;;;; ====================================================================== -;;;; -;;;; Description ========================================================== -;;;; ====================================================================== +;;;; Updated: $Id$ ;;;; -;;;; Initialisation utilities for running regression tests on CLSQL-USQL. +;;;; Initialisation utilities for running regression tests on CLSQL. ;;;; ;;;; ====================================================================== -(in-package #:clsql-usql-tests) +(in-package #:clsql-tests) + +(defvar *rt-connection*) +(defvar *rt-fddl*) +(defvar *rt-fdml*) +(defvar *rt-ooddl*) +(defvar *rt-oodml*) +(defvar *rt-syntax*) (defvar *test-database-type* nil) -(defvar *test-database-server* "") -(defvar *test-database-name* "") -(defvar *test-database-user* "") -(defvar *test-database-password* "") +(defvar *test-database-user* nil) (defclass thing () ((extraterrestrial :initform nil :initarg :extraterrestrial))) @@ -216,30 +216,13 @@ :last-name "Putin" :email "putin@soviet.org")) -(defun test-database-connection-spec () - (let ((dbserver *test-database-server*) - (dbname *test-database-name*) - (dbpassword *test-database-password*) - (dbtype *test-database-type*) - (username *test-database-user*)) - (case dbtype - (:postgresql - `("" ,dbname ,username ,dbpassword)) - (:postgresql-socket - `(,dbserver ,dbname ,username ,dbpassword)) - (:mysql - `("" ,dbname ,username ,dbpassword)) - (:sqlite - `(,dbname)) - (:oracle - `(,username ,dbpassword ,dbname)) - (t - (error "Unrecognized database type: ~A" dbtype))))) - -(defun test-connect-to-database (database-type) +(defun test-connect-to-database (database-type spec) (setf *test-database-type* database-type) + (when (>= (length spec) 3) + (setq *test-database-user* (third spec))) + ;; Connect to the database - (usql:connect (test-database-connection-spec) + (clsql:connect spec :database-type database-type :make-default t :if-exists :old)) @@ -251,66 +234,98 @@ forms))) (defun test-initialise-database () - ;; Delete the instance records + ;; Delete the instance records (with-ignore-errors - (usql:delete-instance-records company1) - (usql:delete-instance-records employee1) - (usql:delete-instance-records employee2) - (usql:delete-instance-records employee3) - (usql:delete-instance-records employee4) - (usql:delete-instance-records employee5) - (usql:delete-instance-records employee6) - (usql:delete-instance-records employee7) - (usql:delete-instance-records employee8) - (usql:delete-instance-records employee9) - (usql:delete-instance-records employee10) + (clsql:delete-instance-records company1) + (clsql:delete-instance-records employee1) + (clsql:delete-instance-records employee2) + (clsql:delete-instance-records employee3) + (clsql:delete-instance-records employee4) + (clsql:delete-instance-records employee5) + (clsql:delete-instance-records employee6) + (clsql:delete-instance-records employee7) + (clsql:delete-instance-records employee8) + (clsql:delete-instance-records employee9) + (clsql:delete-instance-records employee10) ;; Drop the required tables if they exist - (usql:drop-view-from-class 'employee) - (usql:drop-view-from-class 'company)) + (clsql:drop-view-from-class 'employee) + (clsql:drop-view-from-class 'company)) ;; Create the tables for our view classes - (usql:create-view-from-class 'employee) - (usql:create-view-from-class 'company) + (clsql:create-view-from-class 'employee) + (clsql:create-view-from-class 'company) ;; Lenin manages everyone - (usql:add-to-relation employee2 'manager employee1) - (usql:add-to-relation employee3 'manager employee1) - (usql:add-to-relation employee4 'manager employee1) - (usql:add-to-relation employee5 'manager employee1) - (usql:add-to-relation employee6 'manager employee1) - (usql:add-to-relation employee7 'manager employee1) - (usql:add-to-relation employee8 'manager employee1) - (usql:add-to-relation employee9 'manager employee1) - (usql:add-to-relation employee10 'manager employee1) + (clsql:add-to-relation employee2 'manager employee1) + (clsql:add-to-relation employee3 'manager employee1) + (clsql:add-to-relation employee4 'manager employee1) + (clsql:add-to-relation employee5 'manager employee1) + (clsql:add-to-relation employee6 'manager employee1) + (clsql:add-to-relation employee7 'manager employee1) + (clsql:add-to-relation employee8 'manager employee1) + (clsql:add-to-relation employee9 'manager employee1) + (clsql:add-to-relation employee10 'manager employee1) ;; Everyone works for Widgets Inc. - (usql:add-to-relation company1 'employees employee1) - (usql:add-to-relation company1 'employees employee2) - (usql:add-to-relation company1 'employees employee3) - (usql:add-to-relation company1 'employees employee4) - (usql:add-to-relation company1 'employees employee5) - (usql:add-to-relation company1 'employees employee6) - (usql:add-to-relation company1 'employees employee7) - (usql:add-to-relation company1 'employees employee8) - (usql:add-to-relation company1 'employees employee9) - (usql:add-to-relation company1 'employees employee10) + (clsql:add-to-relation company1 'employees employee1) + (clsql:add-to-relation company1 'employees employee2) + (clsql:add-to-relation company1 'employees employee3) + (clsql:add-to-relation company1 'employees employee4) + (clsql:add-to-relation company1 'employees employee5) + (clsql:add-to-relation company1 'employees employee6) + (clsql:add-to-relation company1 'employees employee7) + (clsql:add-to-relation company1 'employees employee8) + (clsql:add-to-relation company1 'employees employee9) + (clsql:add-to-relation company1 'employees employee10) ;; Lenin is president of Widgets Inc. - (usql:add-to-relation company1 'president employee1) + (clsql:add-to-relation company1 'president employee1) ;; store these instances - (usql:update-records-from-instance employee1) - (usql:update-records-from-instance employee2) - (usql:update-records-from-instance employee3) - (usql:update-records-from-instance employee4) - (usql:update-records-from-instance employee5) - (usql:update-records-from-instance employee6) - (usql:update-records-from-instance employee7) - (usql:update-records-from-instance employee8) - (usql:update-records-from-instance employee9) - (usql:update-records-from-instance employee10) - (usql:update-records-from-instance company1)) + (clsql:update-records-from-instance employee1) + (clsql:update-records-from-instance employee2) + (clsql:update-records-from-instance employee3) + (clsql:update-records-from-instance employee4) + (clsql:update-records-from-instance employee5) + (clsql:update-records-from-instance employee6) + (clsql:update-records-from-instance employee7) + (clsql:update-records-from-instance employee8) + (clsql:update-records-from-instance employee9) + (clsql:update-records-from-instance employee10) + (clsql:update-records-from-instance company1)) -(defun test-usql (backend) - (format t "~&Running CLSQL-USQL tests with ~A backend.~%" backend) - (test-connect-to-database backend) - (test-initialise-database) - (rtest:do-tests)) +(defun run-tests () + (let ((specs (read-specs))) + (unless specs + (warn "Not running tests because test configuration file is missing") + (return-from run-tests :skipped)) + (load-necessary-systems specs) + (dolist (db-type +all-db-types+) + (let ((spec (db-type-spec db-type specs))) + (when spec + (do-tests-for-backend spec db-type)))))) +(defun load-necessary-systems (specs) + (dolist (db-type +all-db-types+) + (when (db-type-spec db-type specs) + (db-type-ensure-system db-type)))) +(defun do-tests-for-backend (spec db-type) + (format t + "~& +******************************************************************* +*** Running CLSQL tests with ~A backend. +******************************************************************* +" db-type) + (regression-test:rem-all-tests) + + ;; Tests of clsql-base + (ignore-errors (destroy-database spec :database-type db-type)) + (ignore-errors (create-database spec :database-type db-type)) + (with-tests (:name "CLSQL") + (test-basic spec db-type)) + + (ignore-errors (destroy-database spec :database-type db-type)) + (ignore-errors (create-database spec :database-type db-type)) + (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml* + *rt-ooddl* *rt-oodml* *rt-syntax*)) + (eval test)) + (test-connect-to-database db-type spec) + (test-initialise-database) + (rtest:do-tests))