X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=005c247f803c47bf1b1d471eb2890427221728af;hb=e5744a78271044484b3399d4fc1d55b3e8808784;hp=33349084864afe13b0fa4027e650c1d4c941d678;hpb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f;p=clsql.git diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 3334908..005c247 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -1,25 +1,42 @@ ;;;; -*- 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> +;;;; Updated: $Id$ ;;;; ====================================================================== ;;;; ;;;; Description ========================================================== ;;;; ====================================================================== ;;;; -;;;; Initialisation utilities for running regression tests on CLSQL-USQL. +;;;; Initialisation utilities for running regression tests on CLSQL. ;;;; ;;;; ====================================================================== -(in-package #:clsql-usql-tests) +;;; This test suite looks for a configuration file named ".clsql-test.config" +;;; located in the users home directory. +;;; +;;; This file contains a single a-list that specifies the connection +;;; specs for each database type to be tested. For example, to test all +;;; platforms, a sample "test.config" may look like: +;;; +;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret")) +;;; (:aodbc ("my-dsn" "a-user" "pass")) +;;; (:postgresql ("localhost" "another-db" "user2" "dont-tell")) +;;; (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")) +;;; (:sqlite ("path-to-sqlite-db"))) + +(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 +233,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 +251,83 @@ 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)) - -(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)) - + (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 run-tests () + (let ((specs (read-specs))) + (unless specs + (warn "Not running tests because test configuration file is missing") + (return-from run-tests :skipped)) + (dolist (db-type +all-db-types+) + (let ((spec (db-type-spec db-type specs))) + (when spec + (format t +"~& +******************************************************************* +*** Running CLSQL tests with ~A backend. +******************************************************************* +" db-type) + (db-type-ensure-system db-type) + (regression-test:rem-all-tests) + (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))))))