X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=assert.lisp;h=ec82b4c13353947dd9bf61cb0f0203c51a370454;hp=f9ddec259ad0e6fe5c6d18d95510dc35dc9528cb;hb=HEAD;hpb=e2bf8174193c9acc013b8bbbc116b7e7acc86526 diff --git a/assert.lisp b/assert.lisp index f9ddec2..ec82b4c 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$ ;;;; Purpose: Assert functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -10,19 +10,19 @@ (in-package #:xlunit) -(define-condition assertion-failed (simple-condition) +(define-condition assertion-failed (simple-condition) ((message :initform nil :initarg :message :accessor message)) (:documentation "Base class for all test failures.")) (defmethod print-object ((obj assertion-failed) stream) (print-unreadable-object (obj stream :type t :identity nil) (apply #'format stream (simple-condition-format-control obj) - (simple-condition-format-arguments obj)))) + (simple-condition-format-arguments obj)))) (defun failure-message (message &optional format-str &rest args) "Signal a test failure and exit the test." (signal 'assertion-failed :message message :format-control format-str - :format-arguments args)) + :format-arguments args)) (defun failure (format-str &rest args) "Signal a test failure and exit the test." @@ -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,31 +48,31 @@ `(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 - (values)) + (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))) + (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))))) + (failure-message ,message + "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 - (values)) + (progn + ,form + (values)) (serious-condition (,cond) - (unless (typep ,cond ,condition) - (failure-message ,message "Assert not condition ~A" - ,condition)))))) + (unless (typep ,cond ,condition) + (failure-message ,message "Assert not condition ~A" + ,condition))))))