--- a/tests/ChangeLog	Fri Jun 23 21:51:19 2006 +0000
+++ b/tests/ChangeLog	Sat Jun 24 13:50:23 2006 +0000
@@ -1,3 +1,7 @@
+2006-06-24  Stephen J. Turnbull  <stephen@xemacs.org>
+
+	* automated/test-harness.el: Improve handling of unexpected errors.
+
 2006-06-03  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/mule-tests.el:

--- a/tests/automated/test-harness.el	Fri Jun 23 21:51:19 2006 +0000
+++ b/tests/automated/test-harness.el	Sat Jun 24 13:50:23 2006 +0000
@@ -45,6 +45,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 +151,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 +162,6 @@
        (defvar missing-message-failures)
        (defvar other-failures)
 
-       (defvar unexpected-test-suite-failure)
        (defvar trick-optimizer)
 
        ,@(nreverse body))))
@@ -158,6 +175,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 +183,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*"
@@ -320,7 +337,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)
@@ -341,6 +358,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)
@@ -383,7 +401,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)
@@ -510,7 +532,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))))