3 (in-package :it.bese.FiveAM)
7 ;;;; At the lowest level testing the system requires that certain
8 ;;;; forms be evaluated and that certain post conditions are met: the
9 ;;;; value returned must satisfy a certain predicate, the form must
10 ;;;; (or must not) signal a certain condition, etc. In FiveAM these
11 ;;;; low level operations are called 'checks' and are defined using
12 ;;;; the various checking macros.
14 ;;;; Checks are the basic operators for collecting results. Tests and
15 ;;;; test suites on the other hand allow grouping multiple checks into
16 ;;;; logic collections.
18 (defvar *test-dribble* t)
20 (defmacro with-*test-dribble* (stream &body body)
21 `(let ((*test-dribble* ,stream))
22 (declare (special *test-dribble*))
25 (eval-when (:compile-toplevel :load-toplevel :execute)
26 (def-special-environment run-state ()
30 ;;;; ** Types of test results
32 ;;;; Every check produces a result object.
34 (defclass test-result ()
35 ((reason :accessor reason :initarg :reason :initform "no reason given")
36 (test-case :accessor test-case :initarg :test-case))
37 (:documentation "All checking macros will generate an object of
40 (defclass test-passed (test-result)
42 (:documentation "Class for successful checks."))
44 (defgeneric test-passed-p (object)
46 (:method ((o test-passed)) t))
48 (defclass test-failure (test-result)
50 (:documentation "Class for unsuccessful checks."))
52 (defgeneric test-failure-p (object)
54 (:method ((o test-failure)) t))
56 (defclass unexpected-test-failure (test-failure)
57 ((actual-condition :accessor actual-condition :initarg :condition))
58 (:documentation "Represents the result of a test which neither
59 passed nor failed, but signaled an error we couldn't deal
62 Note: This is very different than a SIGNALS check which instead
63 creates a TEST-PASSED or TEST-FAILURE object."))
65 (defclass test-skipped (test-result)
67 (:documentation "A test which was not run. Usually this is due
68 to unsatisfied dependencies, but users can decide to skip test
71 (defgeneric test-skipped-p (object)
73 (:method ((o test-skipped)) t))
75 (defun add-result (result-type &rest make-instance-args)
76 "Create a TEST-RESULT object of type RESULT-TYPE passing it the
77 initialize args MAKE-INSTANCE-ARGS and adds the resulting
78 object to the list of test results."
79 (with-run-state (result-list current-test)
80 (let ((result (apply #'make-instance result-type (append make-instance-args (list :test-case current-test)))))
82 (test-passed (format *test-dribble* "."))
83 (test-failure (format *test-dribble* "f"))
84 (test-skipped (format *test-dribble* "s")))
85 (push result result-list))))
87 ;;;; ** The check operators
91 (defmacro is (test &rest reason-args)
92 "The DWIM checking operator.
94 If TEST returns a true value a test-passed result is generated,
95 otherwise a test-failure result is generated and the reason,
96 unless REASON-ARGS is provided, is generated based on the form of
99 (predicate expected actual) - Means that we want to check
100 whether, according to PREDICATE, the ACTUAL value is
101 in fact what we EXPECTED.
103 (predicate value) - Means that we want to ensure that VALUE
106 Wrapping the TEST form in a NOT simply preducse a negated reason string."
109 "Argument to IS must be a list, not ~S" test)
111 (add-result 'test-passed)
112 (add-result 'test-failure
113 :reason ,(if (null reason-args)
114 (list-match-case test
115 ((not (?predicate ?expected ?actual))
116 `(format nil "~S was ~S to ~S" ,?actual ',?predicate ,?expected))
117 ((not (?satisfies ?value))
118 `(format nil "~S satisfied ~S" ,?value ',?satisfies))
119 ((?predicate ?expected ?actual)
120 `(format nil "~S was not ~S to ~S" ,?actual ',?predicate ,?expected))
122 `(format nil "~S did not satisfy ~S" ,?value ',?satisfies))
124 `(is-true ,test ,@reason-args)))
125 `(format nil ,@reason-args)))))
127 ;;;; *** Other checks
129 (defmacro skip (&rest reason)
130 "Generates a TEST-SKIPPED result."
132 (format *test-dribble* "s")
133 (add-result 'test-skipped :reason (format nil ,@reason))))
135 (defmacro is-true (condition &rest reason-args)
136 "Like IS this check generates a pass if CONDITION returns true
137 and a failure if CONDITION returns false. Unlike IS this check
138 does not inspect CONDITION to determine how to report the
141 (add-result 'test-passed)
142 (add-result 'test-failure :reason ,(if reason-args
143 `(format nil ,@reason-args)
144 `(format nil "~S did not return a true value" ',condition)))))
146 (defmacro is-false (condition &rest reason-args)
147 "Generates a pass if CONDITION returns false, generates a
148 failure otherwise. Like IS-TRUE, and unlike IS, IS-FALSE does
149 not inspect CONDITION to determine what reason to give it case
152 (add-result 'test-failure :reason ,(if reason-args
153 `(format nil ,@reason-args)
154 `(format nil "~S returned a true value" ',condition)))
155 (add-result 'test-passed)))
157 (defmacro signals (condition &body body)
158 "Generates a pass if BODY signals a condition of type
159 CONDITION. BODY is evaluated in a block named NIL, CONDITION is
161 (let ((block-name (gensym)))
163 (handler-bind ((,condition (lambda (c)
165 ;; ok, body threw condition
166 (add-result 'test-passed)
167 (return-from ,block-name t))))
170 (add-result 'test-failure :reason (format nil "Failed to signal a ~S" ',condition))
171 (return-from ,block-name nil))))))
173 (defmacro finishes (&body body)
174 "Generates a pass if BODY executes to normal completion. In
175 other words if body does signal, return-from or throw this test
183 (add-result 'test-passed)
184 (add-result 'test-failure
185 :reason (format nil "Test didn't finish"))))))
187 (defmacro pass (&rest message-args)
188 "Simply generate a PASS."
189 `(add-result 'test-passed ,@(when message-args
190 `(:reason (format nil ,@message-args)))))
192 (defmacro fail (&rest message-args)
193 "Simply generate a FAIL."
194 `(add-result 'test-failure ,@(when message-args
195 `(:reason (format nil ,@message-args)))))
197 ;; Copyright (c) 2002-2003, Edward Marco Baringer
198 ;; All rights reserved.
200 ;; Redistribution and use in source and binary forms, with or without
201 ;; modification, are permitted provided that the following conditions are
204 ;; - Redistributions of source code must retain the above copyright
205 ;; notice, this list of conditions and the following disclaimer.
207 ;; - Redistributions in binary form must reproduce the above copyright
208 ;; notice, this list of conditions and the following disclaimer in the
209 ;; documentation and/or other materials provided with the distribution.
211 ;; - Neither the name of Edward Marco Baringer, nor BESE, nor the names
212 ;; of its contributors may be used to endorse or promote products
213 ;; derived from this software without specific prior written permission.
215 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
216 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
217 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
218 ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
219 ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
220 ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
221 ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
222 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
223 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
224 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
225 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE