Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 1413:aa15a2bbba1a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-04-15 15:56:56 by stephent] known bug status changes and new macros <87r883bvuy.fsf@tleepslib.sk.tsukuba.ac.jp> <87u1czbvzo.fsf_-_@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Tue, 15 Apr 2003 15:56:58 +0000
parents 3f6adebda25c
children 74cb069b8417
comparison
equal deleted inserted replaced
1412:583b76a7eb90 1413:aa15a2bbba1a
31 ;;; The actual tests are in other files in this directory. 31 ;;; The actual tests are in other files in this directory.
32 ;;; Basically you just create files of emacs-lisp, and use the 32 ;;; Basically you just create files of emacs-lisp, and use the
33 ;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions 33 ;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions
34 ;;; to create tests. See `test-harness-from-buffer' below. 34 ;;; to create tests. See `test-harness-from-buffer' below.
35 ;;; Don't suppress tests just because they're due to known bugs not yet 35 ;;; Don't suppress tests just because they're due to known bugs not yet
36 ;;; fixed -- use the Known-Bug-Expect-Failure wrapper macro to mark them. 36 ;;; fixed -- use the Known-Bug-Expect-Failure and
37 ;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them.
37 ;;; A lot of the tests we run push limits; suppress Ebola message with the 38 ;;; A lot of the tests we run push limits; suppress Ebola message with the
38 ;;; Ignore-Ebola wrapper macro. 39 ;;; Ignore-Ebola wrapper macro.
39 ;;; 40 ;;;
40 ;;; You run the tests using M-x test-emacs-test-file, 41 ;;; You run the tests using M-x test-emacs-test-file,
41 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ... 42 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
140 (debug-on-error t) 141 (debug-on-error t)
141 (pass-stream nil)) 142 (pass-stream nil))
142 (with-output-to-temp-buffer "*Test-Log*" 143 (with-output-to-temp-buffer "*Test-Log*"
143 (princ (format "Testing %s...\n\n" filename)) 144 (princ (format "Testing %s...\n\n" filename))
144 145
145 (defconst test-harness-expect-bug nil) 146 (defconst test-harness-failure-tag "FAIL")
147 (defconst test-harness-success-tag "PASS")
146 148
147 (defmacro Known-Bug-Expect-Failure (&rest body) 149 (defmacro Known-Bug-Expect-Failure (&rest body)
148 `(let ((test-harness-expect-bug t)) ,@body)) 150 `(let ((test-harness-failure-tag "KNOWN BUG")
151 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
152 ,@body))
153
154 (defmacro Implementation-Incomplete-Expect-Failure (&rest body)
155 `(let ((test-harness-failure-tag "IMPLEMENTATION INCOMPLETE")
156 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
157 ,@body))
149 158
150 (defun Print-Failure (fmt &rest args) 159 (defun Print-Failure (fmt &rest args)
151 (setq fmt (format "%s: %s" 160 (setq fmt (format "%s: %s" test-harness-failure-tag fmt))
152 (if test-harness-expect-bug
153 "KNOWN BUG"
154 "FAIL")
155 fmt))
156 (if (noninteractive) (apply #'message fmt args)) 161 (if (noninteractive) (apply #'message fmt args))
157 (princ (concat (apply #'format fmt args) "\n"))) 162 (princ (concat (apply #'format fmt args) "\n")))
158 163
159 (defun Print-Pass (fmt &rest args) 164 (defun Print-Pass (fmt &rest args)
160 (setq fmt (concat "PASS: " fmt)) 165 (setq fmt (format "%s: %s" test-harness-success-tag fmt))
161 ;; #### should warn if expecting failure here!
162 (and test-harness-verbose 166 (and test-harness-verbose
163 (princ (concat (apply #'format fmt args) "\n")))) 167 (princ (concat (apply #'format fmt args) "\n"))))
164 168
165 (defun Print-Skip (test reason &optional fmt &rest args) 169 (defun Print-Skip (test reason &optional fmt &rest args)
166 (setq fmt (concat "SKIP: %S BECAUSE %S" fmt)) 170 (setq fmt (concat "SKIP: %S BECAUSE %S" fmt))