21.4 SXEmacs
Untested on those trees, so I can't quite RECOMMEND it.
This patch implements both of my recent patches to XEmacs 21.5's test
suite in <871wte8y3i.fsf(a)tleepslib.sk.tsukuba.ac.jp> and
<87wtb67hm2.fsf(a)tleepslib.sk.tsukuba.ac.jp> for XEmacs 21.4 (current
CVS) and SXEmacs sxemacs--main--22.1.6 (sorry about the ancient
version, I tried to update but tla timed out, don't know why yet).
Path should apply to either tree with no offsets and no fuzz.
Basically the patch provides two improvements. The first is that
"unexpected errors" are tracked and reported at the end. The second
is that a new test suite API, Silence-Message, is provided to wrap
functions that might call `message' and clutter up the test suite
output with irrelevant remarks about setting the mark or writing
files.
The main difference from the 21.5 patch set is that neither 21.4 nor
SXEmacs has the region-tests.el test file, so that file got dropped.
AFAIK it's relevant to both, but Adrian Aichner would be the one to
ask. If so, I suppose you can simply copy the 21.5 CVS HEAD version,
which will get you both the tests and my noise-suppression patch.
A minor difference is that the mule-tests.el portion of the patch is
less invasive than in 21.5. In 21.5, Silence-Message is applied only
to write-region, while in this patch, I simply substituted
Silence-Message for its expansion to a flet. (I would have done the
same as in 21.5, but that hunk failed to apply, so I did the less
invasive change, which avoids a bunch of spurious whitespace change.)
Rationale is provided in the posts referenced above.
Index: tests/ChangeLog
===================================================================
RCS file:
/Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/tests/ChangeLog,v
retrieving revision 1.2.2.44
diff -u -r1.2.2.44 ChangeLog
--- tests/ChangeLog 29 Jan 2006 00:00:56 -0000 1.2.2.44
+++ tests/ChangeLog 24 Jun 2006 14:31:55 -0000
@@ -0,0 +1,11 @@
+2006-06-24 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * automated/test-harness.el (Silence-Message): New macro.
+ * automated/mule-tests.el: Use it.
+ * automated/region-tests.el: Use it.
+ * automated/tag-tests.el: Use it.
+
+2006-06-24 Stephen J. Turnbull <stephen(a)xemacs.org>
+
+ * automated/test-harness.el: Improve handling of unexpected errors.
+
Index: tests/automated/mule-tests.el
===================================================================
RCS file:
/Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/tests/automated/mule-tests.el,v
retrieving revision 1.2.2.4
diff -u -r1.2.2.4 mule-tests.el
--- tests/automated/mule-tests.el 8 Dec 2005 01:31:23 -0000 1.2.2.4
+++ tests/automated/mule-tests.el 24 Jun 2006 14:33:36 -0000
@@ -301,8 +301,7 @@
(name1 (make-temp-name prefix))
(name2 (make-temp-name prefix))
(file-name-coding-system 'iso-8859-2))
- ;; This is how you suppress output from `message', called by `write-region'
- (flet ((append-message (&rest args) ()))
+ (Silence-Message
(Assert (not (equal name1 name2)))
;; Kludge to handle Mac OS X which groks only UTF-8.
(cond ((eq system-type 'darwin)
Index: tests/automated/tag-tests.el
===================================================================
RCS file:
/Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/tests/automated/tag-tests.el,v
retrieving revision 1.2.2.1
diff -u -r1.2.2.1 tag-tests.el
--- tests/automated/tag-tests.el 13 May 2004 00:10:58 -0000 1.2.2.1
+++ tests/automated/tag-tests.el 24 Jun 2006 14:32:20 -0000
@@ -68,20 +68,23 @@
(let ((tags-always-exact t))
;; Search for the tag "mystruct"; this should succeed
- (find-tag "mystruct")
+ (Silence-Message
+ (find-tag "mystruct"))
(Assert (eq (point) 2))
;; Search again. The search should fail, based on the patch that
;; Sven Grundmann submitted for 21.4.16.
(Check-Error-Message error "No more entries matching mystruct"
- (tags-loop-continue)))
+ (Silence-Message
+ (tags-loop-continue))))
(let ((tags-always-exact nil))
;; Search for the definition of "require". Until the etags.el upgrade
;; from 21.5 in 21.4.16, this test would fail.
(condition-case nil
- (find-tag "require")
+ (Silence-Message
+ (find-tag "require"))
(t t))
(Assert (eq (point) 52)))
Index: tests/automated/test-harness.el
===================================================================
RCS file:
/Users/steve/Software/Repositories/cvs.xemacs.org/XEmacs/xemacs/tests/automated/test-harness.el,v
retrieving revision 1.2.2.5
diff -u -r1.2.2.5 test-harness.el
--- tests/automated/test-harness.el 23 Oct 2003 02:04:04 -0000 1.2.2.5
+++ tests/automated/test-harness.el 24 Jun 2006 14:32:20 -0000
@@ -38,6 +38,14 @@
;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them.
;;; A lot of the tests we run push limits; suppress Ebola message with the
;;; Ignore-Ebola wrapper macro.
+;;; Some noisy code will call `message'. Output from `message' can be
+;;; suppressed with the Silence-Message macro. Functions that are known to
+;;; issue messages include `write-region', `find-tag', `tag-loop-continue',
+;;; `insert', and `mark-whole-buffer'. N.B. The Silence-Message macro
+;;; currently does not suppress the newlines printed by `message'.
+;;; Definitely do not use Silence-Message with Check-Message.
+;;; In general it should probably only be used on code that prepares for a
+;;; test, not on tests.
;;;
;;; You run the tests using M-x test-emacs-test-file,
;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
@@ -45,6 +53,23 @@
(require 'bytecomp)
+(defvar unexpected-test-suite-failures 0
+ "Cumulative number of unexpected failures since test-harness was loaded.
+
+\"Unexpected failures\" are those caught by a generic handler established
+outside of the test context. As such they involve an abort of the test
+suite for the file being tested.
+
+They often occur during preparation of a test or recording of the results.
+For example, an executable used to generate test data might not be present
+on the system, or a system error might occur while reading a data file.")
+
+(defvar unexpected-test-suite-failure-files nil
+ "List of test files causing unexpected failures.")
+
+;; Declared for dynamic scope; _do not_ initialize here.
+(defvar unexpected-test-file-failures)
+
(defvar test-harness-test-compiled nil
"Non-nil means the test code was compiled before execution.")
@@ -134,6 +159,7 @@
(setq body (cons (read buffer) body)))
(end-of-file nil)
(error
+ (incf unexpected-test-file-failures)
(princ (format "Unexpected error %S reading forms from buffer\n"
error-info))))
`(lambda ()
@@ -144,7 +170,6 @@
(defvar missing-message-failures)
(defvar other-failures)
- (defvar unexpected-test-suite-failure)
(defvar trick-optimizer)
,@(nreverse body))))
@@ -158,6 +183,7 @@
(wrong-error-failures 0)
(missing-message-failures 0)
(other-failures 0)
+ (unexpected-test-file-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
@@ -165,7 +191,6 @@
(skipped-test-reasons (make-hash-table :test 'equal))
(trick-optimizer nil)
- (unexpected-test-suite-failure nil)
(debug-on-error t)
(pass-stream nil))
(with-output-to-temp-buffer "*Test-Log*"
@@ -267,7 +292,7 @@
,quoted-body ',expected-error error-info)
(incf wrong-error-failures)))))
-
+ ;; Do not use this with Silence-Message.
(defmacro Check-Message (expected-message-regexp &rest body)
(Skip-Test-Unless (fboundp 'defadvice)
"can't defadvice"
@@ -299,6 +324,10 @@
(incf other-failures)))
(ad-unadvise 'message)))))
+ ;; #### Perhaps this should override `message' itself, too?
+ (defmacro Silence-Message (&rest body)
+ `(flet ((append-message (&rest args) ())) ,@body))
+
(defmacro Ignore-Ebola (&rest body)
`(let ((debug-issue-ebola-notices -42)) ,@body))
@@ -313,7 +342,7 @@
(condition-case error-info
(funcall (test-harness-read-from-buffer inbuffer))
(error
- (setq unexpected-test-suite-failure t)
+ (incf unexpected-test-file-failures)
(princ (format "Unexpected error %S while executing interpreted code\n"
error-info))
(message "Unexpected error %S while executing interpreted code." error-info)
@@ -334,6 +363,7 @@
(condition-case error-info
(if code (funcall code))
(error
+ (incf unexpected-test-file-failures)
(princ (format "Unexpected error %S while executing byte-compiled code\n"
error-info))
(message "Unexpected error %S while executing byte-compiled code."
error-info)
@@ -376,7 +406,11 @@
(cons (list filename passes total)
test-harness-file-results-alist))
(message "%s" summary-msg))
- (when unexpected-test-suite-failure
+ (when (> unexpected-test-file-failures 0)
+ (setq unexpected-test-suite-failure-files
+ (cons filename unexpected-test-suite-failure-files))
+ (setq unexpected-test-suite-failures
+ (+ unexpected-test-suite-failures unexpected-test-file-failures))
(message "Test suite execution failed unexpectedly."))
(fmakunbound 'Assert)
(fmakunbound 'Check-Error)
@@ -503,7 +537,23 @@
(/ (* 100 nsucc) ntest))
(message test-harness-null-summary-template
(concat basename ":")))
- (setq results (cdr results))))))
+ (setq results (cdr results)))))
+ (when (> unexpected-test-suite-failures 0)
+ (message "\n***** There %s %d unexpected test suite %s in %s:"
+ (if (= unexpected-test-suite-failures 1) "was" "were")
+ unexpected-test-suite-failures
+ (if (= unexpected-test-suite-failures 1) "failure" "failures")
+ (if (= (length unexpected-test-suite-failure-files) 1)
+ "file"
+ "files"))
+ (while unexpected-test-suite-failure-files
+ (let ((line (pop unexpected-test-suite-failure-files)))
+ (while (and (< (length line) 61)
+ unexpected-test-suite-failure-files)
+ (setq line
+ (concat line " "
+ (pop unexpected-test-suite-failure-files))))
+ (message line)))))
(message "\nDone")
(kill-emacs (if error 1 0))))
--
School of Systems and Information Engineering
http://turnbull.sk.tsukuba.ac.jp
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Ask not how you can "do" free software business;
ask what your business can "do for" free software.