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 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
  11 ;;;;
  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 ;;;; *************************************************************************
  16
  17 (in-package #:clsql-tests)
  18
  19 (defun %get-int (v)
  20   (etypecase v
  21     (string (parse-integer v :junk-allowed t))
  22     (integer v)
  23     (number (truncate v))))
  24
  25 (defvar *config-pathname*
  26   (make-pathname :defaults (user-homedir-pathname)
  27                  :name ".clsql-test"
  28                  :type "config"))
  29
  30 (defvar +all-db-types+
  31   '(:postgresql :postgresql-socket :postgresql-socket3 :mysql :sqlite :sqlite3 :odbc :oracle
  32     #+allegro :aodbc))
  33
  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"))
  45
  46
  47 (defun read-specs (&optional (path *config-pathname*))
  48   (if (probe-file path)
  49       (with-open-file (stream path :direction :input)
  50         (let ((specs (make-instance 'conn-specs)))
  51           (dolist (spec (read stream) specs)
  52             (push (second spec)
  53                   (slot-value specs (intern (symbol-name (first spec))
  54                                             (find-package '#:clsql-tests)))))))
  55       (progn
  56         (warn "CLSQL test config file ~S not found" path)
  57         nil)))
  58
  59 (defun spec-fn (db-type)
  60   (intern (concatenate 'string (symbol-name db-type)
  61                        (symbol-name '#:-spec))
  62           (find-package '#:clsql-tests)))
  63
  64 (defun db-type-spec (db-type specs)
  65   (funcall (spec-fn db-type) specs))
  66
  67
  68 (defun summarize-test-report (sexp &optional (output *standard-output*))
  69   (flet ((db-title (db-type underlying-db-type)
  70            (format nil "~A~A"
  71                    db-type
  72                    (if (eq db-type underlying-db-type)
  73                        ""
  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)))
  78             ((eq form eof))
  79           (destructuring-bind (db-type
  80                                underlying-db-type
  81                                utime
  82                                total-tests
  83                                failed-tests
  84                                impl-type
  85                                impl-version
  86                                machine-type)
  87               form
  88             (declare (ignorable utime impl-version))
  89             (if failed-tests
  90                 (format output "~&~A: ~D of ~D tests failed (~A, ~A).~&"
  91                         (db-title db-type underlying-db-type)
  92                         (length failed-tests)
  93                         total-tests
  94                         machine-type
  95                         impl-type)
  96                 (format output "~&~A: All ~D tests passed (~A, ~A).~%"
  97                         (db-title db-type underlying-db-type)
  98                         total-tests
  99                         machine-type
 100                         impl-type))))))))