Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 973:ea6a06f7bf2c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-08-22 14:56:23 by stephent] implement test skipping <87d6sblzat.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Thu, 22 Aug 2002 14:56:32 +0000
parents 17ba576dc36a
children 0d33547d9ed3
comparison
equal deleted inserted replaced
972:3fd7fb7868b3 973:ea6a06f7bf2c
122 (no-error-failures 0) 122 (no-error-failures 0)
123 (wrong-error-failures 0) 123 (wrong-error-failures 0)
124 (missing-message-failures 0) 124 (missing-message-failures 0)
125 (other-failures 0) 125 (other-failures 0)
126 126
127 ;; #### perhaps this should be a defvar, and output at the very end
128 ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find
129 ;; what stuff is needed, and ways to avoid using them
130 (skipped-test-reasons (make-hash-table :test 'equal))
131
127 (trick-optimizer nil) 132 (trick-optimizer nil)
128 (unexpected-test-suite-failure nil) 133 (unexpected-test-suite-failure nil)
129 (debug-on-error t) 134 (debug-on-error t)
130 (pass-stream nil)) 135 (pass-stream nil))
131 (with-output-to-temp-buffer "*Test-Log*" 136 (with-output-to-temp-buffer "*Test-Log*"
138 143
139 (defun Print-Pass (fmt &rest args) 144 (defun Print-Pass (fmt &rest args)
140 (setq fmt (concat "PASS: " fmt)) 145 (setq fmt (concat "PASS: " fmt))
141 (and test-harness-verbose 146 (and test-harness-verbose
142 (princ (concat (apply #'format fmt args) "\n")))) 147 (princ (concat (apply #'format fmt args) "\n"))))
148
149 (defun Print-Skip (test reason &optional fmt &rest args)
150 (setq fmt (concat "SKIP: %S. REASON: %S" fmt))
151 (princ (concat (apply #'format fmt test reason args) "\n")))
143 152
144 153
145 (defmacro Assert (assertion) 154 (defmacro Assert (assertion)
146 `(condition-case error-info 155 `(condition-case error-info
147 (progn 156 (progn
199 ,quoted-body ',expected-error error-info) 208 ,quoted-body ',expected-error error-info)
200 (incf wrong-error-failures))))) 209 (incf wrong-error-failures)))))
201 210
202 211
203 (defmacro Check-Message (expected-message-regexp &rest body) 212 (defmacro Check-Message (expected-message-regexp &rest body)
204 (let ((quoted-body (if (= 1 (length body)) 213 (if (not (fboundp 'defadvice))
205 `(quote ,(car body)) `(quote (progn ,@body))))) 214 ;; #### This whole thing should go inside a macro Skip-Test
206 `(let ((messages "")) 215 (let* ((reason "advice unavailable")
207 (defadvice message (around collect activate) 216 (count (gethash reason skipped-test-reasons)))
208 (defvar messages) 217 ;(message "%S: %S" reason count)
209 (let ((msg-string (apply 'format (ad-get-args 0)))) 218 (puthash reason (if (null count) 1 (1+ count))
210 (setq messages (concat messages msg-string)) 219 skipped-test-reasons)
211 msg-string)) 220 `(Print-Skip ,expected-message-regexp ,reason))
212 (condition-case error-info 221 (let ((quoted-body (if (= 1 (length body))
213 (progn 222 `(quote ,(car body))
214 (setq trick-optimizer (progn ,@body)) 223 `(quote (progn ,@body)))))
215 (if (string-match ,expected-message-regexp messages) 224 `(let ((messages ""))
216 (progn 225 (defadvice message (around collect activate)
217 (Print-Pass "%S ==> value %S, message %S, matching %S, as expected" 226 (defvar messages)
218 ,quoted-body trick-optimizer messages ',expected-message-regexp) 227 (let ((msg-string (apply 'format (ad-get-args 0))))
219 (incf passes)) 228 (setq messages (concat messages msg-string))
220 (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S" 229 msg-string))
221 ,quoted-body trick-optimizer messages 230 (condition-case error-info
222 ',expected-message-regexp) 231 (progn
223 (incf missing-message-failures))) 232 (setq trick-optimizer (progn ,@body))
224 (error 233 (if (string-match ,expected-message-regexp messages)
225 (Print-Failure "%S ==> unexpected error %S" 234 (progn
226 ,quoted-body error-info) 235 (Print-Pass "%S ==> value %S, message %S, matching %S, as expected"
227 (incf other-failures))) 236 ,quoted-body trick-optimizer messages ',expected-message-regexp)
228 (ad-unadvise 'message)))) 237 (incf passes))
238 (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S"
239 ,quoted-body trick-optimizer messages
240 ',expected-message-regexp)
241 (incf missing-message-failures)))
242 (error
243 (Print-Failure "%S ==> unexpected error %S"
244 ,quoted-body error-info)
245 (incf other-failures)))
246 (ad-unadvise 'message)))))
229 247
230 (defmacro Ignore-Ebola (&rest body) 248 (defmacro Ignore-Ebola (&rest body)
231 `(let ((debug-issue-ebola-notices -42)) ,@body)) 249 `(let ((debug-issue-ebola-notices -42)) ,@body))
232 250
233 (defun Int-to-Marker (pos) 251 (defun Int-to-Marker (pos)
282 (basename (file-name-nondirectory filename)) 300 (basename (file-name-nondirectory filename))
283 (summary-msg 301 (summary-msg
284 (if (> total 0) 302 (if (> total 0)
285 (format "%s: %d of %d (%d%%) tests successful." 303 (format "%s: %d of %d (%d%%) tests successful."
286 basename passes total (/ (* 100 passes) total)) 304 basename passes total (/ (* 100 passes) total))
287 (format "%s: No tests run" basename)))) 305 (format "%s: No tests run" basename)))
306 (reasons ""))
307 (maphash (lambda (key value)
308 (setq reasons
309 (concat reasons
310 (format "\n %d tests skipped because %s"
311 value key))))
312 skipped-test-reasons)
313 (when (> (length reasons) 1)
314 (setq summary-msg (concat summary-msg reasons "
315 Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH
316 to the package hierarchy root or configure with --package-path to enable
317 the skipped tests.")))
288 (message "%s" summary-msg)) 318 (message "%s" summary-msg))
289 (when unexpected-test-suite-failure 319 (when unexpected-test-suite-failure
290 (message "Test suite execution failed unexpectedly.")) 320 (message "Test suite execution failed unexpectedly."))
291 (fmakunbound 'Assert) 321 (fmakunbound 'Assert)
292 (fmakunbound 'Check-Error) 322 (fmakunbound 'Check-Error)