X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=fixture.lisp;h=4238a9df9373ee165c6904cb0979a410de554f25;hp=84f28bf500cf06a9960ce225b4cb3c0c0c0981ee;hb=HEAD;hpb=8133177de9c5d202520bd83b5e797ef7a39942ad diff --git a/fixture.lisp b/fixture.lisp index 84f28bf..4238a9d 100644 --- a/fixture.lisp +++ b/fixture.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: fixture.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $ +;;;; ID: $Id$ ;;;; Purpose: Test fixtures for XLUnit ;;;; ;;;; ************************************************************************* @@ -48,41 +48,41 @@ that the setup method did for this instance.")) `(if ,test (handler-case ,form - ,@cases) + ,@cases) ,form)) (defmacro unwind-protect-if (test protected cleanup) `(if ,test (unwind-protect - ,protected - ,cleanup) + ,protected + ,cleanup) (progn ,protected ,cleanup))) (defmethod run-test ((test test-fixture) - &key (result (make-instance 'test-result)) - (handle-errors t)) + &key (result (make-instance 'test-result)) + (handle-errors t)) "Perform the test represented by the given test-case or test-suite. Returns a test-result object." (incf (test-count result)) (with-slots (failures errors) result (unwind-protect-if handle-errors - (handler-case-if handle-errors - (let ((res (progn (setup test) - (funcall (test-fn test) test)))) - (when (typep res 'test-failure-condition) - (push (make-test-failure test res) failures))) - (test-failure-condition (failure) - (push (make-test-failure test failure) failures)) - (error (err) - (push (make-test-failure test err) errors))) - - (if handle-errors - (handler-case - (teardown test) - (error (err) - (push (make-test-failure test err) errors))) - (teardown test)))) + (handler-case-if handle-errors + (let ((res (progn (setup test) + (funcall (test-fn test) test)))) + (when (typep res 'test-failure-condition) + (push (make-test-failure test res) failures))) + (test-failure-condition (failure) + (push (make-test-failure test failure) failures)) + (error (err) + (push (make-test-failure test err) errors))) + + (if handle-errors + (handler-case + (teardown test) + (error (err) + (push (make-test-failure test err) errors))) + (teardown test)))) result) @@ -92,15 +92,15 @@ the method that will be invoked when perfoming this test, and can be a symbol or a lambda taking a single argument, the test-fixture instance. DESCRIPTION is obviously what it says it is." (let ((newtest (make-instance fixture - :test-name (etypecase name - (symbol - (string-downcase (symbol-name name))) - (string - name)) - :test-fn - (if(and (symbolp name) (null test-fn)) - name - test-fn) - :description description))) + :test-name (etypecase name + (symbol + (string-downcase (symbol-name name))) + (string + name)) + :test-fn + (if(and (symbolp name) (null test-fn)) + name + test-fn) + :description description))) (when test-suite (add-test newtest test-suite)) newtest))