Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 4891:732c35cdded8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix failing-case output of Assert-test, add Assert-test-not -------------------- ChangeLog entries follow: -------------------- tests/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * automated/test-harness.el (test-harness-from-buffer): Update doc string of `Assert-test' and change the failing-case message to be clearer. Also add `Assert-test-not' for asserting that a comparison should fail.
author Ben Wing <ben@xemacs.org>
date Wed, 27 Jan 2010 06:00:09 -0600
parents 9bf09492cff7
children 6ef8256a020a db2db229ee82
comparison
equal deleted inserted replaced
4890:276e07b3cc93 4891:732c35cdded8
207 (princ (format "Testing %s...\n\n" filename)) 207 (princ (format "Testing %s...\n\n" filename))
208 208
209 (defconst test-harness-failure-tag "FAIL") 209 (defconst test-harness-failure-tag "FAIL")
210 (defconst test-harness-success-tag "PASS") 210 (defconst test-harness-success-tag "PASS")
211 211
212 ;;;;; BEGIN DEFINITION OF MACROS USEFUL IN TEST CODE
213
212 (defmacro Known-Bug-Expect-Failure (&rest body) 214 (defmacro Known-Bug-Expect-Failure (&rest body)
215 "Wrap a BODY that consists of tests that are known to fail.
216 This causes messages to be printed on failure indicating that this is expected,
217 and on success indicating that this is unexpected."
213 `(let ((test-harness-failure-tag "KNOWN BUG") 218 `(let ((test-harness-failure-tag "KNOWN BUG")
214 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) 219 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
215 ,@body)) 220 ,@body))
216 221
217 (defmacro Known-Bug-Expect-Error (expected-error &rest body) 222 (defmacro Known-Bug-Expect-Error (expected-error &rest body)
223 "Wrap a BODY that consists of tests that are known to trigger an error.
224 This causes messages to be printed on failure indicating that this is expected,
225 and on success indicating that this is unexpected."
218 (let ((quoted-body (if (= 1 (length body)) 226 (let ((quoted-body (if (= 1 (length body))
219 `(quote ,(car body)) `(quote (progn ,@body))))) 227 `(quote ,(car body)) `(quote (progn ,@body)))))
220 `(let ((test-harness-failure-tag "KNOWN BUG") 228 `(let ((test-harness-failure-tag "KNOWN BUG")
221 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) 229 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
222 (condition-case error-info 230 (condition-case error-info
235 (Print-Failure "%S ==> expected error %S, got error %S instead" 243 (Print-Failure "%S ==> expected error %S, got error %S instead"
236 ,quoted-body ',expected-error error-info) 244 ,quoted-body ',expected-error error-info)
237 (incf wrong-error-failures)))))) 245 (incf wrong-error-failures))))))
238 246
239 (defmacro Implementation-Incomplete-Expect-Failure (&rest body) 247 (defmacro Implementation-Incomplete-Expect-Failure (&rest body)
248 "Wrap a BODY containing tests that are known to fail due to incomplete code.
249 This causes messages to be printed on failure indicating that the
250 implementation is incomplete (and hence the failure is expected); and on
251 success indicating that this is unexpected."
240 `(let ((test-harness-failure-tag "IMPLEMENTATION INCOMPLETE") 252 `(let ((test-harness-failure-tag "IMPLEMENTATION INCOMPLETE")
241 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) 253 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
242 ,@body)) 254 ,@body))
243 255
244 (defun Print-Failure (fmt &rest args) 256 (defun Print-Failure (fmt &rest args)
291 "%S ==> error: %S") 303 "%S ==> error: %S")
292 ,description error-info ,failing-case) 304 ,description error-info ,failing-case)
293 (incf other-failures) 305 (incf other-failures)
294 )))) 306 ))))
295 307
308 ;;;;; BEGIN DEFINITION OF SPECIFIC KINDS OF ASSERT MACROS
309
296 (defmacro Assert-test (test testval expected &optional failing-case 310 (defmacro Assert-test (test testval expected &optional failing-case
297 description) 311 description)
298 "Test passes if TESTVAL is equal to EXPECTED, using TEST as comparator. 312 "Test passes if TESTVAL compares correctly to EXPECTED using TEST.
299 TEST should be a function such as `eq', `equal', `equalp', `=', `<=', etc. 313 TEST should be a two-argument predicate (i.e. a function of two arguments
300 Optional FAILING-CASE describes the particular failure; any value given 314 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
301 here will be concatenated with a phrase describing the expected and actual 315 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
302 values of the comparison. Optional DESCRIPTION describes the assertion; by 316 particular failure; any value given here will be concatenated with a phrase
303 default, the unevalated comparison expressions are given. FAILING-CASE and 317 describing the expected and actual values of the comparison. Optional
304 DESCRIPTION are useful when Assert is used in a loop." 318 DESCRIPTION describes the assertion; by default, the unevalated comparison
319 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
320 is used in a loop."
305 (let* ((assertion `(,test ,testval ,expected)) 321 (let* ((assertion `(,test ,testval ,expected))
306 (failmsg `(format "expected %S, got %S" ,expected ,testval)) 322 (failmsg `(format "%S should be `%s' to %S but isn't"
323 ,testval ',test ,expected))
324 (failmsg2 (if failing-case `(concat
325 (format "%S, " ,failing-case)
326 ,failmsg)
327 failmsg)))
328 `(Assert ,assertion ,failmsg2 ,description)))
329
330 (defmacro Assert-test-not (test testval expected &optional failing-case
331 description)
332 "Test passes if TESTVAL does not compare correctly to EXPECTED using TEST.
333 TEST should be a two-argument predicate (i.e. a function of two arguments
334 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
335 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
336 particular failure; any value given here will be concatenated with a phrase
337 describing the expected and actual values of the comparison. Optional
338 DESCRIPTION describes the assertion; by default, the unevalated comparison
339 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
340 is used in a loop."
341 (let* ((assertion `(,test ,testval ,expected))
342 (failmsg `(format "%S shouldn't be `%s' to %S but is"
343 ,testval ',test ,expected))
307 (failmsg2 (if failing-case `(concat 344 (failmsg2 (if failing-case `(concat
308 (format "%S, " ,failing-case) 345 (format "%S, " ,failing-case)
309 ,failmsg) 346 ,failmsg)
310 failmsg))) 347 failmsg)))
311 `(Assert ,assertion ,failmsg2 ,description))) 348 `(Assert ,assertion ,failmsg2 ,description)))