Mercurial > hg > xemacs-beta
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)