;;;; 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
;;;;
;;;; *************************************************************************
(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)
;;;; 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)
(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
(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))
(*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)
(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)