From b889ac95ba72db60faa35fe08b360aaa33a795ed Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 10 Aug 2003 07:39:33 +0000 Subject: [PATCH] r5485: *** empty log message *** --- assert.lisp | 12 ++++++------ package.lisp | 8 ++++++-- printer.lisp | 26 +++++++++++++++----------- result.lisp | 6 ++++-- tests.lisp | 9 ++++++--- textui.lisp | 6 +++--- xlunit.asd | 4 ++-- 7 files changed, 42 insertions(+), 29 deletions(-) diff --git a/assert.lisp b/assert.lisp index f9ddec2..e2d7356 100644 --- a/assert.lisp +++ b/assert.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: assert.lisp,v 1.9 2003/08/08 00:57:20 kevin Exp $ +;;;; ID: $Id: assert.lisp,v 1.10 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Assert functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -34,7 +34,7 @@ (defun assert-eql (v1 v2 &optional message) (unless (eql v1 v2) - (failure-message message "Assert eql: ~S ~S" v1 v2))) + (failure-message message "Assert equal: ~S ~S" v1 v2))) (defun assert-not-eql (v1 v2 &optional message) (when (eql v1 v2) @@ -48,11 +48,11 @@ `(when ,v (failure-message ,message "Assert false: ~S" ',v))) -(defmacro assert-condition (condition forms &optional message) +(defmacro assert-condition (condition form &optional message) (let ((cond (gensym "COND-"))) `(handler-case (progn - ,forms + ,form (values)) (t (,cond) (when (and (typep ,cond 'serious-condition) @@ -66,11 +66,11 @@ "Assert condition ~A, but no condition signaled" ,condition))))) -(defmacro assert-not-condition (condition forms &optional message) +(defmacro assert-not-condition (condition form &optional message) (let ((cond (gensym "COND-"))) `(handler-case (progn - ,forms + ,form (values)) (serious-condition (,cond) (unless (typep ,cond ,condition) diff --git a/package.lisp b/package.lisp index 2bdfee5..dce7657 100644 --- a/package.lisp +++ b/package.lisp @@ -2,10 +2,10 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: package.lisp,v 1.11 2003/08/08 00:57:20 kevin Exp $ +;;;; ID: $Id: package.lisp,v 1.12 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Package definition for XLUnit ;;;; -;;;; $Id: package.lisp,v 1.11 2003/08/08 00:57:20 kevin Exp $ +;;;; $Id: package.lisp,v 1.12 2003/08/10 07:39:33 kevin Exp $ ;;;; ************************************************************************* (in-package #:cl-user) @@ -25,8 +25,11 @@ ;; assert #:assert-equal + #:assert-eql + #:assert-not-eql #:assert-true #:assert-false + #:assert-condition #:test #:test-error #:test-no-error @@ -44,6 +47,7 @@ #:remove-test #:tests #:get-suite + #:suite #:test-suite #:run-on-test-results diff --git a/printer.lisp b/printer.lisp index ad351c8..8cfeab9 100644 --- a/printer.lisp +++ b/printer.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: printer.lisp,v 1.6 2003/08/05 22:56:25 kevin Exp $ +;;;; ID: $Id: printer.lisp,v 1.7 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Printer functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -30,22 +30,26 @@ (let ((count (length defects))) (if (= 1 count) (format (ostream obj) "~%There was 1 ~A:~%" title) - (format (ostream obj) "~%There were ~D A:~%" + (format (ostream obj) "~%There were ~D ~A:~%" count title)) (dotimes (i count) (let* ((defect (nth i defects)) (condition (thrown-condition defect))) (format (ostream obj) "~A) ~A: " (1+ i) (name (failed-test defect))) - (apply #'format (ostream obj) - (simple-condition-format-control condition) - (simple-condition-format-arguments condition)) - (format (ostream obj) "~%") - (when (message condition) - (let ((spaces (+ 2 (length (format nil "~D" count))))) - (dotimes (i spaces) - (write-char #\space (ostream obj)))) - (format (ostream obj) "~A~%" (message condition)))))))) + (typecase condition + (assertion-failed + (apply #'format (ostream obj) + (simple-condition-format-control condition) + (simple-condition-format-arguments condition)) + (format (ostream obj) "~%") + (when (message condition) + (let ((spaces (+ 2 (length (format nil "~D" count))))) + (dotimes (i spaces) + (write-char #\space (ostream obj)))) + (format (ostream obj) "~A~%" (message condition)))) + (t + (format (ostream obj) "~A~%" condition)))))))) (defmethod print-footer ((obj textui-test-runner) result) diff --git a/result.lisp b/result.lisp index 28baaa5..66f69ee 100644 --- a/result.lisp +++ b/result.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: result.lisp,v 1.7 2003/08/05 22:56:25 kevin Exp $ +;;;; ID: $Id: result.lisp,v 1.8 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Result functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -31,7 +31,9 @@ (defmethod start-test ((tcase test) (res test-results)) (incf (run-tests res)) - (mapc (lambda (listener) (start-test listener tcase)) (listeners res)) + (mapc (lambda (listener) + (start-test listener tcase)) + (listeners res)) res) (defmethod end-test ((tcase test) (res test-results)) diff --git a/tests.lisp b/tests.lisp index 8042fe8..540b2bb 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Id: $Id: tests.lisp,v 1.14 2003/08/08 00:57:20 kevin Exp $ +;;;; Id: $Id: tests.lisp,v 1.15 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Self Test suite for XLUnit ;;;; ;;;; ************************************************************************* @@ -49,6 +49,7 @@ (def-test-method test-condition-without-cond ((self was-run) :run nil) (assert-condition 'error (list 'no-error))) +#+ignore (def-test-method test-not-condition-with-cond ((self was-run) :run nil) (assert-not-condition 'test-condition (signal 'test-condition))) @@ -126,7 +127,7 @@ (def-test-method test-condition ((self test-case-test) :run nil) (assert-condition 'test-condition - (error (make-instance 'test-condition)))) + (error 'test-condition))) (def-test-method test-condition-without-cond ((self test-case-test) :run nil) @@ -134,12 +135,14 @@ (summary (run (named-test 'test-condition-without-cond (get-suite was-run)))))) - + +#+ignore (def-test-method test-not-condition ((self test-case-test) :run nil) (assert-not-condition 'test-condition (progn))) +#+ignore (def-test-method test-not-condition-with-cond ((self test-case-test) :run nil) (assert-equal "1 run, 0 erred, 1 failed" diff --git a/textui.lisp b/textui.lisp index ec617e0..6486c62 100644 --- a/textui.lisp +++ b/textui.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: textui.lisp,v 1.2 2003/08/04 17:04:50 kevin Exp $ +;;;; ID: $Id: textui.lisp,v 1.3 2003/08/10 07:39:33 kevin Exp $ ;;;; Purpose: Text UI for Test Runner ;;;; ;;;; ************************************************************************* @@ -36,5 +36,5 @@ (run-on-test-results ob result) (print-results test-runner result (/ (- (get-internal-real-time) start-time) - internal-time-units-per-second)))) - + internal-time-units-per-second)) + result)) diff --git a/xlunit.asd b/xlunit.asd index 1e9d6c2..76fbc37 100644 --- a/xlunit.asd +++ b/xlunit.asd @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2003 ;;;; -;;;; $Id: xlunit.asd,v 1.8 2003/08/08 00:57:20 kevin Exp $ +;;;; $Id: xlunit.asd,v 1.9 2003/08/10 07:39:33 kevin Exp $ ;;;; ************************************************************************* (defpackage #:xlunit-system (:use #:asdf #:cl)) @@ -41,7 +41,7 @@ )) (defmethod perform ((o test-op) (c (eql (find-system 'xlunit)))) - (operate 'load-op 'xlunit-tests :force t) + (operate 'load-op 'xlunit-tests) (operate 'test-op 'xlunit-tests :force t)) (defsystem xlunit-tests -- 2.34.1