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."))