Mercurial > hg > xemacs-beta

comparison tests/automated/test-harness.el @ 3471:3b1f8220a65e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-06-24 13:50:19 by stephent] Improve handling of unexpected errors in test suite. <871wte8y3i.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Sat, 24 Jun 2006 13:50:23 +0000
parents ab71063baf27
children 43b4a54fbf66
comparison
equal deleted inserted replaced
3470:09127fab1a6e 3471:3b1f8220a65e
42 ;;; You run the tests using M-x test-emacs-test-file, 42 ;;; You run the tests using M-x test-emacs-test-file,
43 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ... 43 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
44 ;;; which is run for you by the `make check' target in the top-level Makefile. 44 ;;; which is run for you by the `make check' target in the top-level Makefile.
45 45
46 (require 'bytecomp) 46 (require 'bytecomp)
47
48 (defvar unexpected-test-suite-failures 0
49 "Cumulative number of unexpected failures since test-harness was loaded.
50
51 \"Unexpected failures\" are those caught by a generic handler established
52 outside of the test context. As such they involve an abort of the test
53 suite for the file being tested.
54
55 They often occur during preparation of a test or recording of the results.
56 For example, an executable used to generate test data might not be present
57 on the system, or a system error might occur while reading a data file.")
58
59 (defvar unexpected-test-suite-failure-files nil
60 "List of test files causing unexpected failures.")
61
62 ;; Declared for dynamic scope; _do not_ initialize here.
63 (defvar unexpected-test-file-failures)
47 64
48 (defvar test-harness-test-compiled nil 65 (defvar test-harness-test-compiled nil
49 "Non-nil means the test code was compiled before execution.") 66 "Non-nil means the test code was compiled before execution.")
50 67
51 (defvar test-harness-verbose 68 (defvar test-harness-verbose
132 (condition-case error-info 149 (condition-case error-info
133 (while t 150 (while t
134 (setq body (cons (read buffer) body))) 151 (setq body (cons (read buffer) body)))
135 (end-of-file nil) 152 (end-of-file nil)
136 (error 153 (error
154 (incf unexpected-test-file-failures)
137 (princ (format "Unexpected error %S reading forms from buffer\n" 155 (princ (format "Unexpected error %S reading forms from buffer\n"
138 error-info)))) 156 error-info))))
139 `(lambda () 157 `(lambda ()
140 (defvar passes) 158 (defvar passes)
141 (defvar assertion-failures) 159 (defvar assertion-failures)
142 (defvar no-error-failures) 160 (defvar no-error-failures)
143 (defvar wrong-error-failures) 161 (defvar wrong-error-failures)
144 (defvar missing-message-failures) 162 (defvar missing-message-failures)
145 (defvar other-failures) 163 (defvar other-failures)
146 164
147 (defvar unexpected-test-suite-failure)
148 (defvar trick-optimizer) 165 (defvar trick-optimizer)
149 166
150 ,@(nreverse body)))) 167 ,@(nreverse body))))
151 168
152 (defun test-harness-from-buffer (inbuffer filename) 169 (defun test-harness-from-buffer (inbuffer filename)
156 (assertion-failures 0) 173 (assertion-failures 0)
157 (no-error-failures 0) 174 (no-error-failures 0)
158 (wrong-error-failures 0) 175 (wrong-error-failures 0)
159 (missing-message-failures 0) 176 (missing-message-failures 0)
160 (other-failures 0) 177 (other-failures 0)
178 (unexpected-test-file-failures 0)
161 179
162 ;; #### perhaps this should be a defvar, and output at the very end 180 ;; #### perhaps this should be a defvar, and output at the very end
163 ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find 181 ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find
164 ;; what stuff is needed, and ways to avoid using them 182 ;; what stuff is needed, and ways to avoid using them
165 (skipped-test-reasons (make-hash-table :test 'equal)) 183 (skipped-test-reasons (make-hash-table :test 'equal))
166 184
167 (trick-optimizer nil) 185 (trick-optimizer nil)
168 (unexpected-test-suite-failure nil)
169 (debug-on-error t) 186 (debug-on-error t)
170 (pass-stream nil)) 187 (pass-stream nil))
171 (with-output-to-temp-buffer "*Test-Log*" 188 (with-output-to-temp-buffer "*Test-Log*"
172 (princ (format "Testing %s...\n\n" filename)) 189 (princ (format "Testing %s...\n\n" filename))
173 190
318 335
319 (princ "Testing Interpreted Lisp\n\n") 336 (princ "Testing Interpreted Lisp\n\n")
320 (condition-case error-info 337 (condition-case error-info
321 (funcall (test-harness-read-from-buffer inbuffer)) 338 (funcall (test-harness-read-from-buffer inbuffer))
322 (error 339 (error
323 (setq unexpected-test-suite-failure t) 340 (incf unexpected-test-file-failures)
324 (princ (format "Unexpected error %S while executing interpreted code\n" 341 (princ (format "Unexpected error %S while executing interpreted code\n"
325 error-info)) 342 error-info))
326 (message "Unexpected error %S while executing interpreted code." error-info) 343 (message "Unexpected error %S while executing interpreted code." error-info)
327 (message "Test suite execution aborted." error-info) 344 (message "Test suite execution aborted." error-info)
328 )) 345 ))
339 (princ (format "Unexpected error %S while byte-compiling code\n" 356 (princ (format "Unexpected error %S while byte-compiling code\n"
340 error-info)))) 357 error-info))))
341 (condition-case error-info 358 (condition-case error-info
342 (if code (funcall code)) 359 (if code (funcall code))
343 (error 360 (error
361 (incf unexpected-test-file-failures)
344 (princ (format "Unexpected error %S while executing byte-compiled code\n" 362 (princ (format "Unexpected error %S while executing byte-compiled code\n"
345 error-info)) 363 error-info))
346 (message "Unexpected error %S while executing byte-compiled code." error-info) 364 (message "Unexpected error %S while executing byte-compiled code." error-info)
347 (message "Test suite execution aborted." error-info) 365 (message "Test suite execution aborted." error-info)
348 ))) 366 )))
381 the skipped tests."))) 399 the skipped tests.")))
382 (setq test-harness-file-results-alist 400 (setq test-harness-file-results-alist
383 (cons (list filename passes total) 401 (cons (list filename passes total)
384 test-harness-file-results-alist)) 402 test-harness-file-results-alist))
385 (message "%s" summary-msg)) 403 (message "%s" summary-msg))
386 (when unexpected-test-suite-failure 404 (when (> unexpected-test-file-failures 0)
405 (setq unexpected-test-suite-failure-files
406 (cons filename unexpected-test-suite-failure-files))
407 (setq unexpected-test-suite-failures
408 (+ unexpected-test-suite-failures unexpected-test-file-failures))
387 (message "Test suite execution failed unexpectedly.")) 409 (message "Test suite execution failed unexpectedly."))
388 (fmakunbound 'Assert) 410 (fmakunbound 'Assert)
389 (fmakunbound 'Check-Error) 411 (fmakunbound 'Check-Error)
390 (fmakunbound 'Check-Message) 412 (fmakunbound 'Check-Message)
391 (fmakunbound 'Check-Error-Message) 413 (fmakunbound 'Check-Error-Message)
508 nsucc 530 nsucc
509 ntest 531 ntest
510 (/ (* 100 nsucc) ntest)) 532 (/ (* 100 nsucc) ntest))
511 (message test-harness-null-summary-template 533 (message test-harness-null-summary-template
512 (concat basename ":"))) 534 (concat basename ":")))
513 (setq results (cdr results)))))) 535 (setq results (cdr results)))))
536 (when (> unexpected-test-suite-failures 0)
537 (message "\n***** There %s %d unexpected test suite %s in %s:"
538 (if (= unexpected-test-suite-failures 1) "was" "were")
539 unexpected-test-suite-failures
540 (if (= unexpected-test-suite-failures 1) "failure" "failures")
541 (if (= (length unexpected-test-suite-failure-files) 1)
542 "file"
543 "files"))
544 (while unexpected-test-suite-failure-files
545 (let ((line (pop unexpected-test-suite-failure-files)))
546 (while (and (< (length line) 61)
547 unexpected-test-suite-failure-files)
548 (setq line
549 (concat line " "
550 (pop unexpected-test-suite-failure-files))))
551 (message line)))))
514 (message "\nDone") 552 (message "\nDone")
515 (kill-emacs (if error 1 0)))) 553 (kill-emacs (if error 1 0))))
516 554
517 (provide 'test-harness) 555 (provide 'test-harness)
518 556