X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=assert.lisp;h=e2d7356d537653937a544727bf1c4885ad2b8018;hb=0114e93940d17c3dd840f37a81d6fb0da66e7a25;hp=d1d779271d4169a8d3bb27fdb4278287666dbab6;hpb=77e80d4f7d2d8a1aea36f9239abc7e1b25500ecc;p=xlunit.git diff --git a/assert.lisp b/assert.lisp index d1d7792..e2d7356 100644 --- a/assert.lisp +++ b/assert.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: assert.lisp,v 1.8 2003/08/06 14:51:01 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,9 +48,31 @@ `(when ,v (failure-message ,message "Assert false: ~S" ',v))) -(defmacro assert-condition (condition v &optional message) - - ) +(defmacro assert-condition (condition form &optional message) + (let ((cond (gensym "COND-"))) + `(handler-case + (progn + ,form + (values)) + (t (,cond) + (when (and (typep ,cond 'serious-condition) + (not (typep ,cond ,condition))) + (failure-message + ,message + "Assert condition ~A, but signaled condition ~A" + ,condition ,cond))) + (:no-error () + (failure-message ,message + "Assert condition ~A, but no condition signaled" + ,condition))))) -(defmacro assert-not-condition (condition v &optional message) - ) +(defmacro assert-not-condition (condition form &optional message) + (let ((cond (gensym "COND-"))) + `(handler-case + (progn + ,form + (values)) + (serious-condition (,cond) + (unless (typep ,cond ,condition) + (failure-message ,message "Assert not condition ~A" + ,condition))))))