+ (princ (format "Testing %s...\n\n" filename))
+
+ (defconst test-harness-failure-tag "FAIL")
+ (defconst test-harness-success-tag "PASS")
+
+ (defmacro Known-Bug-Expect-Failure (&rest body)
+ `(let ((test-harness-failure-tag "KNOWN BUG")
+ (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
+ ,@body))
+
+ (defmacro Implementation-Incomplete-Expect-Failure (&rest body)
+ `(let ((test-harness-failure-tag "IMPLEMENTATION INCOMPLETE")
+ (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
+ ,@body))
+
+ (defun Print-Failure (fmt &rest args)
+ (setq fmt (format "%s: %s" test-harness-failure-tag fmt))
+ (if (noninteractive) (apply #'message fmt args))
+ (princ (concat (apply #'format fmt args) "\n")))
+
+ (defun Print-Pass (fmt &rest args)
+ (setq fmt (format "%s: %s" test-harness-success-tag fmt))
+ (and test-harness-verbose
+ (princ (concat (apply #'format fmt args) "\n"))))
+
+ (defun Print-Skip (test reason &optional fmt &rest args)
+ (setq fmt (concat "SKIP: %S BECAUSE %S" fmt))
+ (princ (concat (apply #'format fmt test reason args) "\n")))
+
+ (defmacro Skip-Test-Unless (condition reason description &rest body)
+ "Unless CONDITION is satisfied, skip test BODY.
+REASON is a description of the condition failure, and must be unique (it
+is used as a hash key). DESCRIPTION describes the tests that were skipped.
+BODY is a sequence of expressions and may contain several tests."
+ `(if (not ,condition)
+ (let ((count (gethash ,reason skipped-test-reasons)))
+ (puthash ,reason (if (null count) 1 (1+ count))
+ skipped-test-reasons)
+ (Print-Skip ,description ,reason))
+ ,@body))