Mercurial > hg > xemacs-beta
changeset 5541:ebd367b82ccd
Improve treatment of expected bugs.
* * *
Simplify Known-Bug-Expect-Error to produce cleaner output.
author | Stephen J. Turnbull <stephen@xemacs.org> |
---|---|
date | Mon, 08 Aug 2011 13:57:19 +0900 |
parents | eed303fac325 |
children | dab422055bab |
files | lisp/ChangeLog lisp/test-harness.el |
diffstat | 2 files changed, 44 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Mon Aug 08 13:57:19 2011 +0900 +++ b/lisp/ChangeLog Mon Aug 08 13:57:19 2011 +0900 @@ -1,9 +1,23 @@ +2011-08-04 Stephen J. Turnbull <stephen@xemacs.org> + + * test-harness.el (test-harness-bug-expected): + Update docstring. + (Known-Bug-Expect-Failure, Known-Bug-Expect-Error): + Ask if bug was fixed in PASS message. + (Known-Bug-Expect-Error): + Simplify code to produce clearer output. + Make pass and failure correspond to Check-Error. + (Print-Pass): + Always print test result for known bugs. + 2011-07-29 Mats Lidell <matsl@xemacs.org> + * process.el (shell-command): * process.el (shell-command-on-region): API compatible/synced with FSF 23.3.1. 2011-07-22 Mats Lidell <matsl@xemacs.or> + * syntax-ppss.el: Synced up with Emacs 23.3 (syntax.el) 2011-07-03 Aidan Kehoe <kehoea@parhasard.net>
--- a/lisp/test-harness.el Mon Aug 08 13:57:19 2011 +0900 +++ b/lisp/test-harness.el Mon Aug 08 13:57:19 2011 +0900 @@ -69,7 +69,8 @@ (defvar unexpected-test-file-failures) (defvar test-harness-bug-expected nil - "Non-nil means a bug is expected; backtracing/debugging should not happen.") + "Non-nil means a bug is expected; backtracing/debugging should not happen. +However, the individual test summary should be printed.") (defvar test-harness-test-compiled nil "Non-nil means the test code was compiled before execution. @@ -325,34 +326,26 @@ and on success indicating that this is unexpected." `(let ((test-harness-bug-expected t) (test-harness-failure-tag "KNOWN BUG") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) + (test-harness-success-tag "PASS (FAIL EXPECTED: was bug fixed?)")) ,@body)) (defmacro Known-Bug-Expect-Error (expected-error &rest body) - "Wrap a BODY that consists of tests that are known to trigger an error. -This causes messages to be printed on failure indicating that this is expected, -and on success indicating that this is unexpected." - (let ((quoted-body (if (eql 1 (length body)) - `(quote ,(car body)) `(quote (progn ,@body))))) - `(let ((test-harness-bug-expected t) - (test-harness-failure-tag "KNOWN BUG") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) - (condition-case error-info - (progn - (setq trick-optimizer (progn ,@body)) - (Print-Pass - "%S executed successfully, but expected error %S" - ,quoted-body - ',expected-error) - (incf passes)) - (,expected-error - (Print-Failure "%S ==> error %S, as expected" - ,quoted-body ',expected-error) - (incf no-error-failures)) - (error - (Print-Failure "%S ==> expected error %S, got error %S instead" - ,quoted-body ',expected-error error-info) - (incf wrong-error-failures)))))) + "Wrap a BODY containing a test known to trigger an error it shouldn't. +This causes messages to be printed on failure indicating that this is expected +of the bug, and on success indicating that this is unexpected." + `(let ((test-harness-bug-expected t) + (test-harness-failure-tag "KNOWN BUG") + (test-harness-success-tag + (format "PASS (EXPECTED ERROR %S due to bug: fixed?)" + (quote ,expected-error)))) + (condition-case err + (progn ,@body) + (,expected-error) + (error + (let ((m (format " Expected %S due to bug, got %S: mutated?\n" + (quote ,expected-error) err))) + (if (noninteractive) (message m)) + (princ m)))))) (defmacro Implementation-Incomplete-Expect-Failure (&rest body) "Wrap a BODY containing tests that are known to fail due to incomplete code. @@ -361,7 +354,8 @@ success indicating that this is unexpected." `(let ((test-harness-bug-expected t) (test-harness-failure-tag "IMPLEMENTATION INCOMPLETE") - (test-harness-success-tag "PASS (FAILURE EXPECTED)")) + (test-harness-success-tag + "PASS (FAILURE EXPECTED: feature implemented?)")) ,@body)) (defun Print-Failure (fmt &rest args) @@ -371,7 +365,9 @@ (defun Print-Pass (fmt &rest args) (setq fmt (format "%s: %s" test-harness-success-tag fmt)) - (and test-harness-verbose + (and (or test-harness-verbose test-harness-bug-expected) + (if (and noninteractive test-harness-bug-expected) + (apply #'message fmt args)) (princ (concat (apply #'format fmt args) "\n")))) (defun Print-Skip (test reason &optional fmt &rest args) @@ -432,18 +428,21 @@ "Assertion failed: %S") ,description ,failing-case) (incf assertion-failures) - (test-harness-assertion-failure-do-debug error-info)) + (test-harness-assertion-failure-do-debug error-info) + nil) (Print-Failure (if ,failing-case "%S ==> error: %S; failing case = %S" "%S ==> error: %S") ,description error-info ,failing-case) (incf other-failures) - (test-harness-unexpected-error-do-debug error-info))) + (test-harness-unexpected-error-do-debug error-info) + nil)) #'(lambda () (assert ,assertion) (Print-Pass "%S" ,description) - (incf passes))) + (incf passes) + t)) (cl-assertion-failed nil)))) (defmacro Check-Error (expected-error &rest body)