From 2dfae2a07c7ee0826a17edde3c23ef493b18bdb5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 20 Jul 2003 18:31:22 +0000 Subject: [PATCH] r5343: *** empty log message *** --- clsql-tests.asd | 6 +- debian/changelog | 6 ++ debian/control | 2 +- tests/README | 14 +-- tests/package.lisp | 4 +- .../{acl-compat-tester.lisp => ptester.lisp} | 88 ++++++++----------- 6 files changed, 59 insertions(+), 61 deletions(-) rename tests/{acl-compat-tester.lisp => ptester.lisp} (91%) diff --git a/clsql-tests.asd b/clsql-tests.asd index 7c4a682..de68088 100644 --- a/clsql-tests.asd +++ b/clsql-tests.asd @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: clsql-tests.asd,v 1.3 2003/06/06 21:59:09 kevin Exp $ +;;;; $Id: clsql-tests.asd,v 1.4 2003/07/20 18:31:22 kevin Exp $ ;;;; ************************************************************************* (in-package #:cl-user) @@ -27,10 +27,10 @@ ((:module tests :components ((:file "rt") - (:file "acl-compat-tester") + (:file "ptester") (:file "package" :depends-on ("rt")) ;; (:file "tables" :depends-on ("package"))) - (:file "tests" :depends-on ("package" "acl-compat-tester"))) + (:file "tests" :depends-on ("package" "ptester"))) ))) (defmethod perform ((o test-op) (c (eql (find-system 'clsql-tests)))) diff --git a/debian/changelog b/debian/changelog index 0e66b89..cdbd88f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (1.7.0-1) unstable; urgency=low + + * Update acl-compat-tester with ptester + + -- Kevin M. Rosenberg Sun, 20 Jul 2003 12:12:36 -0600 + cl-sql (1.6.6-1) unstable; urgency=low * New upstream diff --git a/debian/control b/debian/control index 0197037..fa72663 100644 --- a/debian/control +++ b/debian/control @@ -65,7 +65,7 @@ Description: CLSQL database backend, PostgreSQL Package: cl-sql-tests Architecture: all -Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql +Depends: cl-sql-base, cl-sql-postgresql, cl-sql-postgresql-socket, cl-sql-mysql, cl-rt, cl-tester Suggests: acl-installer, libmyodbc, unixodbc,cl-sql-aodbc Description: Testing suite for CLSQL This package contains a test suite for CLSQL. It requires manual diff --git a/tests/README b/tests/README index a344c4b..3e1b561 100644 --- a/tests/README +++ b/tests/README @@ -1,10 +1,14 @@ These tests require the setup of a configuration file with account -information for MySQL and PostgreSQL SQL servers. Additionally, -the Debian package acl-installer must be installed and a license downloaded -to use the AODBC tests. +information for MySQL and PostgreSQL SQL servers. Additionally, the +Debian package acl-installer must be installed and a license +downloaded to use the AODBC tests. -This test suite looks for a configuration file named ".clsql-test.config" -located in the users home directory. +Furthermore, if you are not using the Debian package of CLSQL, these +tests require the downloading of the rtest and ptester packages from +http://files.b9.com/. + +This test suite looks for a configuration file named +".clsql-test.config" located in the users home directory. This file contains a single a-list that specifies the connection specs for each database type to be tested. For example, to test all diff --git a/tests/package.lisp b/tests/package.lisp index 144f2e1..816c60a 100644 --- a/tests/package.lisp +++ b/tests/package.lisp @@ -7,12 +7,12 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: package.lisp,v 1.3 2003/05/07 02:45:08 kevin Exp $ +;;;; $Id: package.lisp,v 1.4 2003/07/20 18:31:22 kevin Exp $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:clsql-tests - (:use #:asdf #:cl #:clsql #:rtest #:util.test)) + (:use #:asdf #:cl #:clsql #:rtest #:ptester)) diff --git a/tests/acl-compat-tester.lisp b/tests/ptester.lisp similarity index 91% rename from tests/acl-compat-tester.lisp rename to tests/ptester.lisp index e90adc5..7a2cc77 100644 --- a/tests/acl-compat-tester.lisp +++ b/tests/ptester.lisp @@ -1,8 +1,9 @@ -;; tester.cl -;; A test harness for Allegro CL. +;; ptester.lisp +;; A test harness based on Franz's tester module ;; ;; copyright (c) 1985-1986 Franz Inc, Alameda, CA -;; copyright (c) 1986-2001 Franz Inc, Berkeley, CA - All rights reserved. +;; copyright (c) 1986-2002 Franz Inc, Berkeley, CA - All rights reserved. +;; copyright (c) 2001-2003 Kevin Rosenberg (portability changes) ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of @@ -24,11 +25,12 @@ ;; Place, Suite 330, Boston, MA 02111-1307 USA ;; ;;;; from the original ACL 6.1 sources: -;; $Id: acl-compat-tester.lisp,v 1.1 2003/05/02 03:08:58 kevin Exp $ +;; Id: tester.cl,v 2.2.12.1 2001/06/05 18:45:10 layer Exp +;; $Id: ptester.lisp,v 1.1 2003/07/20 18:31:22 kevin Exp $ -(defpackage :util.test - (:use :common-lisp) +(defpackage #:ptester + (:use #:cl) (:shadow #:test) (:export ;;;; Control variables: @@ -48,14 +50,16 @@ #:with-tests )) -(in-package :util.test) +(in-package #:ptester) + +;; Added by Kevin Rosenberg + +(define-condition simple-break (error simple-condition) ()) #+cmu (unless (find-class 'break nil) (define-condition break (simple-condition) ())) -(define-condition simple-break (error simple-condition) ()) - ;; the if* macro used in Allegro: ;; ;; This is in the public domain... please feel free to put this definition @@ -116,8 +120,6 @@ (setq state :init))))) - - (defvar *break-on-test-failures* nil "When a test failure occurs, common-lisp:break is called, allowing interactive debugging of the failure.") @@ -391,27 +393,13 @@ discriminate on new versus known failures." (defvar *announce-test* nil) ;; if true announce each test that was done -(defmacro errorset (form &optional announce catch-breaks) - ;; Evaluate FORM, and if there are no errors and FORM returns - ;; values v1,v2,...,vn, then return values t,v1,v2,...,vn. If an - ;; error occurs while evaluating FORM, then return nil immediately. - ;; If ANNOUNCE is t, then the error message will be printed out. - (if catch-breaks - `(handler-case (values-list (cons t (multiple-value-list ,form))) - (error (condition) - (declare (ignorable condition)) - ,@(if announce `((format *error-output* "~&Error: ~a~%" condition))) - nil) - (simple-break (condition) - (declare (ignorable condition)) - ,@(if announce `((format *error-output* "~&Warning: ~a~%" condition)) -) - nil)) - `(handler-case (values-list (cons t (multiple-value-list ,form))) - (error (condition) - (declare (ignorable condition)) - ,@(if announce `((format *error-output* "~&Error: ~a~%" condition))) - nil)))) +(defmacro errorset (form) ;subset of test-values-errorset + `(handler-case + (values-list (cons t (multiple-value-list ,form))) + (error (cond) + (format *error-output* "~&An error occurred: ~a~%" cond) + nil))) + (defun test-check (&key (predicate #'eql) expected-result test-results test-form @@ -428,12 +416,13 @@ discriminate on new versus known failures." (flet ((check (expected-result result) (let* ((results (multiple-value-list - (errorset (funcall predicate expected-result result) t))) + (errorset (funcall predicate expected-result result)))) (failed (null (car results)))) - (if* failed - then (setq predicate-failed t) - nil - else (cadr results))))) + (if failed + (progn + (setq predicate-failed t) + nil) + (cadr results))))) (when (conditionp test-results) (setq condition test-results) (setq test-results nil)) @@ -569,18 +558,18 @@ Reason: the format-arguments were incorrect.~%") (*test-unexpected-failures* 0)) (format *error-output* "Begin ~a test~%" ,g-name) (if* *break-on-test-failures* - then (doit) - else (handler-case (doit) - (error (c) - (format - *error-output* - "~ + then (doit) + else (handler-case (doit) + (error (c) + (format + *error-output* + "~ ~&Test ~a aborted by signalling an uncaught error:~%~a~%" - ,g-name c)))) + ,g-name c)))) #+allegro (let ((state (sys:gsgc-switch :print))) (setf (sys:gsgc-switch :print) nil) - (format t "~&**********************************~%" ,g-name) + (format t "~&**********************************~%") (format t "End ~a test~%" ,g-name) (format t "Errors detected in this test: ~s " *test-errors*) (unless (zerop *test-unexpected-failures*) @@ -589,12 +578,11 @@ Reason: the format-arguments were incorrect.~%") (setf (sys:gsgc-switch :print) state)) #-allegro (progn - (format t "~&**********************************~%" ,g-name) + (format t "~&**********************************~%") (format t "End ~a test~%" ,g-name) - (format t "Errors detected in this test: ~s " *test-errors*) + (format t "Errors detected in this test: ~D " *test-errors*) (unless (zerop *test-unexpected-failures*) - (format t "UNEXPECTED: ~s" *test-unexpected-failures*)) - (format t "~%Successes this test:~s~%" *test-successes*)) - )))) + (format t "UNEXPECTED: ~D" *test-unexpected-failures*)) + (format t "~%Successes this test:~D~%" *test-successes*)))))) (provide :tester #+module-versions 1.1) -- 2.34.1