Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 1095:0d33547d9ed3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-11-11 15:39:03 by stephent] testing improvements <87adkgyv5v.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Mon, 11 Nov 2002 15:39:07 +0000
parents ea6a06f7bf2c
children 2af1f88a2d31
comparison
equal deleted inserted replaced
1094:4f4c898836ab 1095:0d33547d9ed3
28 ;;; Commentary: 28 ;;; Commentary:
29 29
30 ;;; A test suite harness for testing XEmacs. 30 ;;; A test suite harness for testing XEmacs.
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, and Check-Message functions to create tests. 33 ;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions
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
36 ;;; fixed -- use the Known-Bug-Expect-Failure wrapper macro to mark them.
37 ;;; A lot of the tests we run push limits; suppress Ebola message with the
38 ;;; Ignore-Ebola wrapper macro.
39 ;;;
34 ;;; You run the tests using M-x test-emacs-test-file, 40 ;;; You run the tests using M-x test-emacs-test-file,
35 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ... 41 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
36 ;;; which is run for you by the `make check' target in the top-level Makefile. 42 ;;; which is run for you by the `make check' target in the top-level Makefile.
37 43
38 (require 'bytecomp) 44 (require 'bytecomp)
133 (unexpected-test-suite-failure nil) 139 (unexpected-test-suite-failure nil)
134 (debug-on-error t) 140 (debug-on-error t)
135 (pass-stream nil)) 141 (pass-stream nil))
136 (with-output-to-temp-buffer "*Test-Log*" 142 (with-output-to-temp-buffer "*Test-Log*"
137 (princ (format "Testing %s...\n\n" filename)) 143 (princ (format "Testing %s...\n\n" filename))
144
145 (defconst test-harness-expect-bug nil)
146
147 (defmacro Known-Bug-Expect-Failure (&rest body)
148 `(let ((test-harness-expect-bug t)) ,@body))
138 149
139 (defun Print-Failure (fmt &rest args) 150 (defun Print-Failure (fmt &rest args)
140 (setq fmt (concat "FAIL: " fmt)) 151 (setq fmt (format "%s: %s"
152 (if test-harness-expect-bug
153 "KNOWN BUG"
154 "FAIL")
155 fmt))
141 (if (noninteractive) (apply #'message fmt args)) 156 (if (noninteractive) (apply #'message fmt args))
142 (princ (concat (apply #'format fmt args) "\n"))) 157 (princ (concat (apply #'format fmt args) "\n")))
143 158
144 (defun Print-Pass (fmt &rest args) 159 (defun Print-Pass (fmt &rest args)
145 (setq fmt (concat "PASS: " fmt)) 160 (setq fmt (concat "PASS: " fmt))
146 (and test-harness-verbose 161 (and test-harness-verbose
147 (princ (concat (apply #'format fmt args) "\n")))) 162 (princ (concat (apply #'format fmt args) "\n"))))
148 163
149 (defun Print-Skip (test reason &optional fmt &rest args) 164 (defun Print-Skip (test reason &optional fmt &rest args)
150 (setq fmt (concat "SKIP: %S. REASON: %S" fmt)) 165 (setq fmt (concat "SKIP: %S BECAUSE %S" fmt))
151 (princ (concat (apply #'format fmt test reason args) "\n"))) 166 (princ (concat (apply #'format fmt test reason args) "\n")))
152 167
168 (defmacro Skip-Test-Unless (condition reason description &rest body)
169 "Unless CONDITION is satisfied, skip test BODY.
170 REASON is a description of the condition failure, and must be unique (it
171 is used as a hash key). DESCRIPTION describes the tests that were skipped.
172 BODY is a sequence of expressions and may contain several tests."
173 `(if (not ,condition)
174 (let ((count (gethash ,reason skipped-test-reasons)))
175 (puthash ,reason (if (null count) 1 (1+ count))
176 skipped-test-reasons)
177 (Print-Skip ,description ,reason))
178 ,@body))
153 179
154 (defmacro Assert (assertion) 180 (defmacro Assert (assertion)
155 `(condition-case error-info 181 `(condition-case error-info
156 (progn 182 (progn
157 (assert ,assertion) 183 (assert ,assertion)
208 ,quoted-body ',expected-error error-info) 234 ,quoted-body ',expected-error error-info)
209 (incf wrong-error-failures))))) 235 (incf wrong-error-failures)))))
210 236
211 237
212 (defmacro Check-Message (expected-message-regexp &rest body) 238 (defmacro Check-Message (expected-message-regexp &rest body)
213 (if (not (fboundp 'defadvice)) 239 (Skip-Test-Unless (fboundp 'defadvice)
214 ;; #### This whole thing should go inside a macro Skip-Test 240 "can't defadvice"
215 (let* ((reason "advice unavailable") 241 expected-message-regexp
216 (count (gethash reason skipped-test-reasons)))
217 ;(message "%S: %S" reason count)
218 (puthash reason (if (null count) 1 (1+ count))
219 skipped-test-reasons)
220 `(Print-Skip ,expected-message-regexp ,reason))
221 (let ((quoted-body (if (= 1 (length body)) 242 (let ((quoted-body (if (= 1 (length body))
222 `(quote ,(car body)) 243 `(quote ,(car body))
223 `(quote (progn ,@body))))) 244 `(quote (progn ,@body)))))
224 `(let ((messages "")) 245 `(let ((messages ""))
225 (defadvice message (around collect activate) 246 (defadvice message (around collect activate)
305 (format "%s: No tests run" basename))) 326 (format "%s: No tests run" basename)))
306 (reasons "")) 327 (reasons ""))
307 (maphash (lambda (key value) 328 (maphash (lambda (key value)
308 (setq reasons 329 (setq reasons
309 (concat reasons 330 (concat reasons
310 (format "\n %d tests skipped because %s" 331 (format "\n %d tests skipped because %s."
311 value key)))) 332 value key))))
312 skipped-test-reasons) 333 skipped-test-reasons)
313 (when (> (length reasons) 1) 334 (when (> (length reasons) 1)
314 (setq summary-msg (concat summary-msg reasons " 335 (setq summary-msg (concat summary-msg reasons "
315 Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH 336 Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH