changeset 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 4f4c898836ab
children 2c2ff019dd33
files tests/ChangeLog tests/automated/regexp-tests.el tests/automated/syntax-tests.el tests/automated/test-harness.el
diffstat 4 files changed, 59 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
--- a/tests/ChangeLog	Mon Nov 11 15:34:13 2002 +0000
+++ b/tests/ChangeLog	Mon Nov 11 15:39:07 2002 +0000
@@ -1,3 +1,15 @@
+2002-10-19  Stephen Turnbull  <steve@tleepslib1>
+
+	* automated/test-harness.el (test-harness-expect-bug): New variable.
+	(Known-Bug-Expect-Failure): New macro.
+	(Skip-Test-Unless): New macro.
+	(Check-Message): Use Skip-Test-Unless.
+	(test-harness-from-buffer): Type fixes.
+
+	* automated/regexp-tests.el: Use Known-Bug-Expect-Failure.
+
+	* automated/syntax-tests.el: Use Skip-Test-Unless.
+
 2002-09-09  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* automated/regexp-tests.el: Add test for stale subexpr match-data.
--- a/tests/automated/regexp-tests.el	Mon Nov 11 15:34:13 2002 +0000
+++ b/tests/automated/regexp-tests.el	Mon Nov 11 15:39:07 2002 +0000
@@ -229,10 +229,8 @@
   (Assert (string= (match-string 1) nil)))
 
 ;; Test word boundaries
-(Assert (= (string-match " \\<a" " a") 0))
-(Assert (= (string-match "a\\> " "a ") 0))
-(Assert (= (string-match " \\ba" " a") 0))
-(Assert (= (string-match "a\\b " "a ") 0))
+(Assert (= (string-match "\\<a" " a") 1))
+(Assert (= (string-match "a\\>" "a ") 0))
 (Assert (= (string-match "\\ba" " a") 1))
 (Assert (= (string-match "a\\b" "a ") 0))
 ;; should work at target boundaries
@@ -240,6 +238,10 @@
 (Assert (= (string-match "a\\>" "a") 0))
 (Assert (= (string-match "\\ba" "a") 0))
 (Assert (= (string-match "a\\b" "a") 0))
+;; Check for weirdness
+(Assert (not (string-match " \\> " "  ")))
+(Assert (not (string-match " \\< " "  ")))
+(Assert (not (string-match " \\b " "  ")))
 ;; but not if the "word" would be on the null side of the boundary!
 (Assert (not (string-match "\\<" "")))
 (Assert (not (string-match "\\>" "")))
@@ -247,7 +249,8 @@
 (Assert (not (string-match "\\> " " ")))
 (Assert (not (string-match "a\\<" "a")))
 (Assert (not (string-match "\\>a" "a")))
-;; Expect these to fail :-(
-(Assert (not (string-match "\\b" "")))
-(Assert (not (string-match " \\b" " ")))
-(Assert (not (string-match "\\b " " ")))
+(Known-Bug-Expect-Failure
+ (Assert (not (string-match "\\b" "")))
+ (Assert (not (string-match "\\b" " ")))
+ (Assert (not (string-match " \\b" " ")))
+ (Assert (not (string-match "\\b " " "))))
--- a/tests/automated/syntax-tests.el	Mon Nov 11 15:34:13 2002 +0000
+++ b/tests/automated/syntax-tests.el	Mon Nov 11 15:39:07 2002 +0000
@@ -133,14 +133,9 @@
 ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9
 ;; with sjt's version of Andy's syntax-text-property-killer patch.
 (with-temp-buffer
-  (if (not (fboundp 'c-mode))
-      ;; #### This whole thing should go inside a macro Skip-Test
-      (let* ((reason "c-mode 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 "comment and parse-partial-sexp tests" reason))
+  (Skip-Test-Unless (fboundp 'c-mode)
+		    "c-mode unavailable"
+		    "comment and parse-partial-sexp tests"
     (c-mode)
     
     (insert "// comment\n")
--- 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)