1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Classes and utilities for testing
7 ;;;; Author: Kevin M. Rosenberg
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
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 ;;;; *************************************************************************
19 (in-package #:clsql-tests
)
21 (defvar *config-pathname
*
22 (make-pathname :defaults
(user-homedir-pathname)
26 (defvar +all-db-types
+
27 '(:postgresql
:postgresql-socket
:mysql
:sqlite
:sqlite3
:odbc
:oracle
30 (defclass conn-specs
()
31 ((aodbc :accessor aodbc-spec
:initform nil
)
32 (mysql :accessor mysql-spec
:initform nil
)
33 (postgresql :accessor postgresql-spec
:initform nil
)
34 (postgresql-socket :accessor postgresql-socket-spec
:initform nil
)
35 (sqlite :accessor sqlite-spec
:initform nil
)
36 (sqlite3 :accessor sqlite3-spec
:initform nil
)
37 (odbc :accessor odbc-spec
:initform nil
)
38 (oracle :accessor oracle-spec
:initform nil
))
39 (:documentation
"Connection specs for CLSQL testing"))
42 (defun read-specs (&optional
(path *config-pathname
*))
44 (with-open-file (stream path
:direction
:input
)
45 (let ((specs (make-instance 'conn-specs
)))
46 (dolist (spec (read stream
) specs
)
48 (slot-value specs
(intern (symbol-name (first spec
))
49 (find-package '#:clsql-tests
)))))))
51 (warn "CLSQL test config file ~S not found" path
)
54 (defun spec-fn (db-type)
55 (intern (concatenate 'string
(symbol-name db-type
)
56 (symbol-name '#:-spec
))
57 (find-package '#:clsql-tests
)))
59 (defun db-type-spec (db-type specs
)
60 (funcall (spec-fn db-type
) specs
))
63 (defun summarize-test-report (sexp &optional
(output *standard-output
*))
64 (flet ((db-title (db-type underlying-db-type
)
67 (if (eq db-type underlying-db-type
)
69 (format nil
"/~A" underlying-db-type
)))))
70 (with-open-file (in sexp
:direction
:input
)
71 (let ((eof (cons nil nil
)))
72 (do ((form (read in nil eof
) (read in nil eof
)))
74 (destructuring-bind (db-type
83 (declare (ignorable utime impl-version
))
85 (format output
"~&~A: ~D of ~D tests failed (~A, ~A).~&"
86 (db-title db-type underlying-db-type
)
91 (format output
"~&~A: All ~D tests passed (~A, ~A).~%"
92 (db-title db-type underlying-db-type
)