From: Kevin M. Rosenberg Date: Fri, 18 Jul 2003 19:47:07 +0000 (+0000) Subject: r5320: Auto commit for Debian build X-Git-Url: http://git.kpe.io/?p=ptester.git;a=commitdiff_plain;h=8677e99488829df6eda4ba0b6f1a8cb487e5abd8 r5320: Auto commit for Debian build --- diff --git a/debian/changelog b/debian/changelog index 3d4862a..91aa907 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-tester (1.1.1.5-1) unstable; urgency=low + + * Porting fixes + + -- Kevin M. Rosenberg Fri, 18 Jul 2003 13:43:46 -0600 + cl-tester (1.1.1.4-1) unstable; urgency=low * Improve .asd file diff --git a/tester.asd b/tester.asd index 3bfba96..4e4e135 100644 --- a/tester.asd +++ b/tester.asd @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Sep 2002 ;;;; -;;;; $Id: tester.asd,v 1.3 2003/05/06 16:29:28 kevin Exp $ +;;;; $Id: tester.asd,v 1.4 2003/07/18 19:47:07 kevin Exp $ ;;;; ;;;; This file, part of cl-tester, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -17,7 +17,7 @@ ;;;; ************************************************************************* (defpackage #:tester-system (:use #:asdf #:cl)) -(in-package #:tester-sytsem) +(in-package #:tester-system) #+(and allegro common-lisp-controller) (c-l-c:original-require 'tester) diff --git a/tester.lisp b/tester.lisp index 2a15b4b..0c32225 100644 --- a/tester.lisp +++ b/tester.lisp @@ -26,7 +26,7 @@ ;;;; from the original ACL 6.1 sources: ;; Id: tester.cl,v 2.2.12.1 2001/06/05 18:45:10 layer Exp -;; $Id: tester.lisp,v 1.2 2003/02/23 06:10:02 kevin Exp $ +;; $Id: tester.lisp,v 1.3 2003/07/18 19:47:07 kevin Exp $ (defpackage :util.test (:use :common-lisp) @@ -392,12 +392,14 @@ discriminate on new versus known failures." (defvar *announce-test* nil) ;; if true announce each test that was done -(defmacro errorset (form) - `(handler-case (cons t (multiple-value-list ,form)) +(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 multiple-values fail-info known-failure @@ -415,10 +417,11 @@ discriminate on new versus known failures." (multiple-value-list (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)) @@ -554,14 +557,14 @@ 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) @@ -576,9 +579,9 @@ Reason: the format-arguments were incorrect.~%") (progn (format t "~&**********************************~%" ,g-name) (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)