;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:    utils.lisp
;;;; Purpose: Classes and utilities for testing
;;;; Author:  Kevin M. Rosenberg
;;;; Created: Mar 2002
;;;;
;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************

(in-package #:clsql-tests)

(defvar *config-pathname*
  (make-pathname :defaults (user-homedir-pathname)
		 :name ".clsql-test"
		 :type "config"))

(defvar +all-db-types+
  #-clisp '(:postgresql :postgresql-socket :mysql :sqlite :odbc 
	    #+allegro :aodbc)
  #+clisp '(:sqlite))

(defclass conn-specs ()
  ((aodbc :accessor aodbc-spec :initform nil)
   (odbc :accessor odbc-spec :initform nil)
   (mysql :accessor mysql-spec :initform nil)
   (postgresql :accessor postgresql-spec :initform nil)
   (postgresql-socket :accessor postgresql-socket-spec :initform nil)
   (sqlite :accessor sqlite-spec :initform nil))
  (:documentation "Connection specs for CLSQL testing"))


(defun read-specs (&optional (path *config-pathname*))
  (if (probe-file path)
      (with-open-file (stream path :direction :input)
	(let ((specs (make-instance 'conn-specs)))
	  (dolist (spec (read stream) specs)
	    (push (second spec)
		  (slot-value specs (intern (symbol-name (first spec))
					    (find-package '#:clsql-tests)))))))
      (progn
	(warn "CLSQL test config file ~S not found" path)
	nil)))

(defun spec-fn (db-type)
  (intern (concatenate 'string (symbol-name db-type)
		       (symbol-name '#:-spec))
	  (find-package '#:clsql-tests)))

(defun db-type-spec (db-type specs)
  (funcall (spec-fn db-type) specs))


(defun summarize-test-report (sexp &optional (output *standard-output*))
  (flet ((db-title (db-type underlying-db-type)
	   (format nil "~A~A"
		   db-type 
		   (if (eq db-type underlying-db-type)
		       ""
		       (format nil "/~A" underlying-db-type)))))
    (with-open-file (in sexp :direction :input)
      (let ((eof (cons nil nil)))
	(do ((form (read in nil eof) (read in nil eof)))
	    ((eq form eof))
	  (destructuring-bind (db-type
			       underlying-db-type
			       utime
			       total-tests
			       failed-tests
			       impl-type
			       impl-version
			       machine-type)
	      form
	    (declare (ignoreable utime impl-version))
	    (if failed-tests
		(format output "~&~A: ~D of ~D tests failed (~A, ~A).~&"
			(db-title db-type underlying-db-type)
			(length failed-tests)
			total-tests
			machine-type
			impl-type)
		(format output "~&~A: All ~D tests passed (~A, ~A).~%"
			(db-title db-type underlying-db-type)
			total-tests
			machine-type
			impl-type))))))))