diff tests/automated/test-harness.el @ 1095:0d33547d9ed3

[xemacs-hg @ 2002-11-11 15:39:03 by stephent] testing improvements <87adkgyv5v.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Mon, 11 Nov 2002 15:39:07 +0000
parents ea6a06f7bf2c
children 2af1f88a2d31
line wrap: on
line diff
--- a/tests/automated/test-harness.el	Mon Nov 11 15:34:13 2002 +0000
+++ b/tests/automated/test-harness.el	Mon Nov 11 15:39:07 2002 +0000
@@ -30,7 +30,13 @@
 ;;; A test suite harness for testing XEmacs.
 ;;; The actual tests are in other files in this directory.
 ;;; Basically you just create files of emacs-lisp, and use the
-;;; Assert, Check-Error, and Check-Message functions to create tests.
+;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions
+;;; to create tests.  See `test-harness-from-buffer' below.
+;;; Don't suppress tests just because they're due to known bugs not yet
+;;; fixed -- use the Known-Bug-Expect-Failure wrapper macro to mark them.
+;;; A lot of the tests we run push limits; suppress Ebola message with the
+;;; Ignore-Ebola wrapper macro.
+;;; 
 ;;; You run the tests using M-x test-emacs-test-file,
 ;;; or $(EMACS) -batch -l .../test-harness.el -f batch-test-emacs file ...
 ;;; which is run for you by the `make check' target in the top-level Makefile.
@@ -135,9 +141,18 @@
 	(pass-stream nil))
     (with-output-to-temp-buffer "*Test-Log*"
       (princ (format "Testing %s...\n\n" filename))
+
+      (defconst test-harness-expect-bug nil)
+
+      (defmacro Known-Bug-Expect-Failure (&rest body)
+	`(let ((test-harness-expect-bug t)) ,@body))
     
       (defun Print-Failure (fmt &rest args)
-	(setq fmt (concat "FAIL: " fmt))
+	(setq fmt (format "%s: %s"
+			  (if test-harness-expect-bug
+			      "KNOWN BUG"
+			    "FAIL")
+			  fmt))
 	(if (noninteractive) (apply #'message fmt args))
 	(princ (concat (apply #'format fmt args) "\n")))
 
@@ -147,9 +162,20 @@
 	     (princ (concat (apply #'format fmt args) "\n"))))
 
       (defun Print-Skip (test reason &optional fmt &rest args)
-	(setq fmt (concat "SKIP: %S.  REASON: %S" fmt))
+	(setq fmt (concat "SKIP: %S BECAUSE %S" fmt))
 	(princ (concat (apply #'format fmt test reason args) "\n")))
 
+      (defmacro Skip-Test-Unless (condition reason description &rest body)
+	"Unless CONDITION is satisfied, skip test BODY.
+REASON is a description of the condition failure, and must be unique (it
+is used as a hash key).  DESCRIPTION describes the tests that were skipped.
+BODY is a sequence of expressions and may contain several tests."
+	`(if (not ,condition)
+	     (let ((count (gethash ,reason skipped-test-reasons)))
+	       (puthash ,reason (if (null count) 1 (1+ count))
+			skipped-test-reasons)
+	       (Print-Skip ,description ,reason))
+	   ,@body))
 
       (defmacro Assert (assertion)
 	`(condition-case error-info
@@ -210,14 +236,9 @@
 
 
       (defmacro Check-Message (expected-message-regexp &rest body)
-	(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))
+	(Skip-Test-Unless (fboundp 'defadvice)
+			  "can't defadvice"
+			  expected-message-regexp
 	  (let ((quoted-body (if (= 1 (length body))
 				 `(quote ,(car body))
 			       `(quote (progn ,@body)))))
@@ -307,7 +328,7 @@
 	(maphash (lambda (key value)
 		   (setq reasons
 			 (concat reasons
-				 (format "\n    %d tests skipped because %s"
+				 (format "\n    %d tests skipped because %s."
 					 value key))))
 		 skipped-test-reasons)
 	(when (> (length reasons) 1)