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
10 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:clsql-tests)
21 (string (parse-integer v :junk-allowed t))
23 (number (truncate v))))
25 (defvar *config-pathname*
26 (make-pathname :defaults (user-homedir-pathname)
30 (defvar +all-db-types+
31 '(:postgresql :postgresql-socket :postgresql-socket3 :mysql :sqlite :sqlite3 :odbc :oracle
34 (defclass conn-specs ()
35 ((aodbc :accessor aodbc-spec :initform nil)
36 (mysql :accessor mysql-spec :initform nil)
37 (postgresql :accessor postgresql-spec :initform nil)
38 (postgresql-socket :accessor postgresql-socket-spec :initform nil)
39 (postgresql-socket3 :accessor postgresql-socket3-spec :initform nil)
40 (sqlite :accessor sqlite-spec :initform nil)
41 (sqlite3 :accessor sqlite3-spec :initform nil)
42 (odbc :accessor odbc-spec :initform nil)
43 (oracle :accessor oracle-spec :initform nil))
44 (:documentation "Connection specs for CLSQL testing"))
47 (defun read-specs (&optional (path *config-pathname*))
49 (with-open-file (stream path :direction :input)
50 (let ((specs (make-instance 'conn-specs)))
51 (dolist (spec (read stream) specs)
53 (slot-value specs (intern (symbol-name (first spec))
54 (find-package '#:clsql-tests)))))))
56 (warn "CLSQL test config file ~S not found" path)
59 (defun spec-fn (db-type)
60 (intern (concatenate 'string (symbol-name db-type)
61 (symbol-name '#:-spec))
62 (find-package '#:clsql-tests)))
64 (defun db-type-spec (db-type specs)
65 (funcall (spec-fn db-type) specs))
68 (defun summarize-test-report (sexp &optional (output *standard-output*))
69 (flet ((db-title (db-type underlying-db-type)
72 (if (eq db-type underlying-db-type)
74 (format nil "/~A" underlying-db-type)))))
75 (with-open-file (in sexp :direction :input)
76 (let ((eof (cons nil nil)))
77 (do ((form (read in nil eof) (read in nil eof)))
79 (destructuring-bind (db-type
88 (declare (ignorable utime impl-version))
90 (format output "~&~A: ~D of ~D tests failed (~A, ~A).~&"
91 (db-title db-type underlying-db-type)
96 (format output "~&~A: All ~D tests passed (~A, ~A).~%"
97 (db-title db-type underlying-db-type)