tests/utils.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:    utils.lisp
   6 ;;;; Purpose: Classes and utilities for testing
   7 ;;;; Author:  Kevin M. Rosenberg
   8 ;;;; Created: Mar 2002
   9 ;;;;
  10 ;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:clsql-tests)
  20
  21 (defvar *config-pathname*
  22   (make-pathname :defaults (user-homedir-pathname)
  23                  :name ".clsql-test"
  24                  :type "config"))
  25
  26 (defvar +all-db-types+
  27   #-clisp '(:postgresql :postgresql-socket :sqlite :aodbc :mysql)
  28   #+clisp '(:sqlite))
  29
  30 (defclass conn-specs ()
  31   ((aodbc-spec :accessor aodbc-spec :initform nil)
  32    (mysql-spec :accessor mysql-spec :initform nil)
  33    (pgsql-spec :accessor postgresql-spec :initform nil)
  34    (pgsql-socket-spec :accessor postgresql-socket-spec :initform nil)
  35    (sqlite-spec :accessor sqlite-spec :initform nil))
  36   (:documentation "Connection specs for CLSQL testing"))
  37
  38
  39 (defun read-specs (&optional (path *config-pathname*))
  40   (if (probe-file path)
  41       (with-open-file (stream path :direction :input)
  42         (let ((config (read stream))
  43               (specs (make-instance 'conn-specs)))
  44           (setf (aodbc-spec specs) (cadr (assoc :aodbc config)))
  45           (setf (mysql-spec specs) (cadr (assoc :mysql config)))
  46           (setf (postgresql-spec specs) (cadr (assoc :postgresql config)))
  47           (setf (postgresql-socket-spec specs)
  48                 (cadr (assoc :postgresql-socket config)))
  49           (setf (sqlite-spec specs) (cadr (assoc :sqlite config)))
  50           specs))
  51       (progn
  52         (warn "CLSQL test config file ~S not found" path)
  53         nil)))
  54
  55 (defun db-type-spec (db-type specs)
  56   (let ((accessor (intern (concatenate 'string (symbol-name db-type)
  57                                        (symbol-name '#:-spec))
  58                           (find-package '#:clsql-tests))))
  59     (funcall accessor specs)))
  60
  61 (defun db-type-ensure-system (db-type)
  62   (unless (find-package (symbol-name db-type))
  63     (asdf:operate 'asdf:load-op
  64                   (intern (concatenate 'string
  65                                        (symbol-name '#:clsql-)
  66                                        (symbol-name db-type))))))
  67
  68