Mercurial > hg > xemacs-beta
diff tests/automated/test-harness.el @ 973:ea6a06f7bf2c
[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 |
line wrap: on
line diff
--- a/tests/automated/test-harness.el Thu Aug 22 11:37:57 2002 +0000 +++ b/tests/automated/test-harness.el Thu Aug 22 14:56:32 2002 +0000 @@ -124,6 +124,11 @@ (missing-message-failures 0) (other-failures 0) + ;; #### perhaps this should be a defvar, and output at the very end + ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find + ;; what stuff is needed, and ways to avoid using them + (skipped-test-reasons (make-hash-table :test 'equal)) + (trick-optimizer nil) (unexpected-test-suite-failure nil) (debug-on-error t) @@ -141,6 +146,10 @@ (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. REASON: %S" fmt)) + (princ (concat (apply #'format fmt test reason args) "\n"))) + (defmacro Assert (assertion) `(condition-case error-info @@ -201,31 +210,40 @@ (defmacro Check-Message (expected-message-regexp &rest body) - (let ((quoted-body (if (= 1 (length body)) - `(quote ,(car body)) `(quote (progn ,@body))))) - `(let ((messages "")) - (defadvice message (around collect activate) - (defvar messages) - (let ((msg-string (apply 'format (ad-get-args 0)))) - (setq messages (concat messages msg-string)) - msg-string)) - (condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (if (string-match ,expected-message-regexp messages) - (progn - (Print-Pass "%S ==> value %S, message %S, matching %S, as expected" - ,quoted-body trick-optimizer messages ',expected-message-regexp) - (incf passes)) - (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S" - ,quoted-body trick-optimizer messages - ',expected-message-regexp) - (incf missing-message-failures))) - (error - (Print-Failure "%S ==> unexpected error %S" - ,quoted-body error-info) - (incf other-failures))) - (ad-unadvise 'message)))) + (if (not (fboundp 'defadvice)) + ;; #### This whole thing should go inside a macro Skip-Test + (let* ((reason "advice unavailable") + (count (gethash reason skipped-test-reasons))) + ;(message "%S: %S" reason count) + (puthash reason (if (null count) 1 (1+ count)) + skipped-test-reasons) + `(Print-Skip ,expected-message-regexp ,reason)) + (let ((quoted-body (if (= 1 (length body)) + `(quote ,(car body)) + `(quote (progn ,@body))))) + `(let ((messages "")) + (defadvice message (around collect activate) + (defvar messages) + (let ((msg-string (apply 'format (ad-get-args 0)))) + (setq messages (concat messages msg-string)) + msg-string)) + (condition-case error-info + (progn + (setq trick-optimizer (progn ,@body)) + (if (string-match ,expected-message-regexp messages) + (progn + (Print-Pass "%S ==> value %S, message %S, matching %S, as expected" + ,quoted-body trick-optimizer messages ',expected-message-regexp) + (incf passes)) + (Print-Failure "%S ==> value %S, message %S, NOT matching expected %S" + ,quoted-body trick-optimizer messages + ',expected-message-regexp) + (incf missing-message-failures))) + (error + (Print-Failure "%S ==> unexpected error %S" + ,quoted-body error-info) + (incf other-failures))) + (ad-unadvise 'message))))) (defmacro Ignore-Ebola (&rest body) `(let ((debug-issue-ebola-notices -42)) ,@body)) @@ -284,7 +302,19 @@ (if (> total 0) (format "%s: %d of %d (%d%%) tests successful." basename passes total (/ (* 100 passes) total)) - (format "%s: No tests run" basename)))) + (format "%s: No tests run" basename))) + (reasons "")) + (maphash (lambda (key value) + (setq reasons + (concat reasons + (format "\n %d tests skipped because %s" + value key)))) + skipped-test-reasons) + (when (> (length reasons) 1) + (setq summary-msg (concat summary-msg reasons " + Probably XEmacs cannot find your installed packages. Set EMACSPACKAGEPATH + to the package hierarchy root or configure with --package-path to enable + the skipped tests."))) (message "%s" summary-msg)) (when unexpected-test-suite-failure (message "Test suite execution failed unexpectedly."))