commit: Improve treatment of expected bugs.

changeset: 5541:ebd367b82ccd user: Stephen J. Turnbull <stephen(a)xemacs.org&gt; date: Mon Aug 08 13:57:19 2011 +0900 files: lisp/ChangeLog lisp/test-harness.el description: Improve treatment of expected bugs. * * * Simplify Known-Bug-Expect-Error to produce cleaner output. diff -r eed303fac325 -r ebd367b82ccd lisp/ChangeLog --- 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(a)xemacs.org&gt; + + * 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(a)xemacs.org&gt; + * process.el (shell-command): * process.el (shell-command-on-region): API compatible/synced with FSF 23.3.1. 2011-07-22 Mats Lidell <matsl(a)xemacs.or&gt; + * syntax-ppss.el: Synced up with Emacs 23.3 (syntax.el) 2011-07-03 Aidan Kehoe <kehoea(a)parhasard.net&gt; diff -r eed303fac325 -r ebd367b82ccd lisp/test-harness.el --- 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) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches