1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Assert functions for XLUnit
8 ;;;; *************************************************************************
13 (define-condition assertion-failed (simple-condition)
14 ((message :initform nil :initarg :message :accessor message))
15 (:documentation "Base class for all test failures."))
17 (defmethod print-object ((obj assertion-failed) stream)
18 (print-unreadable-object (obj stream :type t :identity nil)
19 (apply #'format stream (simple-condition-format-control obj)
20 (simple-condition-format-arguments obj))))
22 (defun failure-message (message &optional format-str &rest args)
23 "Signal a test failure and exit the test."
24 (signal 'assertion-failed :message message :format-control format-str
25 :format-arguments args))
27 (defun failure (format-str &rest args)
28 "Signal a test failure and exit the test."
29 (apply #'failure-message nil format-str args))
31 (defun assert-equal (v1 v2 &optional message)
33 (failure-message message "Assert equal: ~S ~S" v1 v2)))
35 (defun assert-eql (v1 v2 &optional message)
37 (failure-message message "Assert equal: ~S ~S" v1 v2)))
39 (defun assert-not-eql (v1 v2 &optional message)
41 (failure-message message "Assert not eql: ~S ~S" v1 v2)))
43 (defmacro assert-true (v &optional message)
45 (failure-message ,message "Assert true: ~S" ',v)))
47 (defmacro assert-false (v &optional message)
49 (failure-message ,message "Assert false: ~S" ',v)))
51 (defmacro assert-condition (condition form &optional message)
52 (let ((cond (gensym "COND-")))
58 (when (and (typep ,cond 'serious-condition)
59 (not (typep ,cond ,condition)))
62 "Assert condition ~A, but signaled condition ~A"
65 (failure-message ,message
66 "Assert condition ~A, but no condition signaled"
69 (defmacro assert-not-condition (condition form &optional message)
70 (let ((cond (gensym "COND-")))
75 (serious-condition (,cond)
76 (unless (typep ,cond ,condition)
77 (failure-message ,message "Assert not condition ~A"