xemacs-beta: lisp/test-harness.el annotate

annotate lisp/test-harness.el @ 5075:868a9ffcc37b

Normally return a compiled function if one argument, #'constantly. 2010-02-24 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (constantly): Normally return a compiled function from #'constantly if we are handed a single argument. Shouldn't actually matter, the overhead for returning a single constant in a lambda form vs. in a compiled function is minuscule, but using compiled functions as much as possible is good style in XEmacs, our interpreter is not stellar (nor indeed should it need to be).

author	Aidan Kehoe <kehoea@parhasard.net>
date	Wed, 24 Feb 2010 17:17:13 +0000
parents	14f0dd1fabdb
children	b24cf478a45e

rev	line source
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1 ;; test-harness.el --- Run Emacs Lisp test suites.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2
1751 5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	3 ;;; Copyright (C) 1998, 2002, 2003 Free Software Foundation, Inc.
4856 9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	4 ;;; Copyright (C) 2002, 2010 Ben Wing.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	6 ;; Author: Martin Buchholz
1761 db7c7e251153 [xemacs-hg @ 2003-10-23 12:48:45 by stephent] stephent parents: 1758 diff changeset	7 ;; Maintainer: Stephen J. Turnbull <stephen@xemacs.org>
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	8 ;; Keywords: testing
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	9
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	11
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	16
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	21
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	23 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	26
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	27 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	28
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	30
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	31 ;;; A test suite harness for testing XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	32 ;;; The actual tests are in other files in this directory.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	33 ;;; Basically you just create files of emacs-lisp, and use the
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	34 ;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	35 ;;; to create tests. See `test-harness-from-buffer' below.
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	36 ;;; Don't suppress tests just because they're due to known bugs not yet
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	37 ;;; fixed -- use the Known-Bug-Expect-Failure and
aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	38 ;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them.
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	39 ;;; A lot of the tests we run push limits; suppress Ebola message with the
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	40 ;;; Ignore-Ebola wrapper macro.
3472 43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	41 ;;; Some noisy code will call `message'. Output from `message' can be
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	42 ;;; suppressed with the Silence-Message macro. Functions that are known to
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	43 ;;; issue messages include `write-region', `find-tag', `tag-loop-continue',
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	44 ;;; `insert', and `mark-whole-buffer'. N.B. The Silence-Message macro
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	45 ;;; currently does not suppress the newlines printed by `message'.
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	46 ;;; Definitely do not use Silence-Message with Check-Message.
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	47 ;;; In general it should probably only be used on code that prepares for a
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	48 ;;; test, not on tests.
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	49 ;;;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	50 ;;; You run the tests using M-x test-emacs-test-file,
5069 14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	51 ;;; or $(EMACS) -batch -l test-harness -f batch-test-emacs file ...
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	52 ;;; which is run for you by the `make check' target in the top-level Makefile.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	53
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	54 (require 'bytecomp)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	55
3471 3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	56 (defvar unexpected-test-suite-failures 0
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	57 "Cumulative number of unexpected failures since test-harness was loaded.
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	58
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	59 \"Unexpected failures\" are those caught by a generic handler established
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	60 outside of the test context. As such they involve an abort of the test
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	61 suite for the file being tested.
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	62
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	63 They often occur during preparation of a test or recording of the results.
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	64 For example, an executable used to generate test data might not be present
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	65 on the system, or a system error might occur while reading a data file.")
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	66
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	67 (defvar unexpected-test-suite-failure-files nil
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	68 "List of test files causing unexpected failures.")
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	69
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	70 ;; Declared for dynamic scope; _do not_ initialize here.
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	71 (defvar unexpected-test-file-failures)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	72
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	73 (defvar test-harness-bug-expected nil
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	74 "Non-nil means a bug is expected; backtracing/debugging should not happen.")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	75
1758 90502933fb98 [xemacs-hg @ 2003-10-21 08:21:00 by stephent] stephent parents: 1751 diff changeset	76 (defvar test-harness-test-compiled nil
4366 7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	77 "Non-nil means the test code was compiled before execution.
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	78
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	79 You probably should not make tests depend on compilation.
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	80 However, it can be useful to conditionally change messages based on whether
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	81 the code was compiled or not. For example, the case that motivated the
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	82 implementation of this variable:
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	83
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	84 \(when test-harness-test-compiled
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	85 ;; this ha-a-ack depends on the failing compiled test coming last
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	86 \(setq test-harness-failure-tag
7b628daa39d4 Move debugging code to usage example. Stephen J. Turnbull <stephen@xemacs.org> parents: 4323 diff changeset	87 \"KNOWN BUG - fix reverted; after 2003-10-31 notify stephen\n\"))")
1758 90502933fb98 [xemacs-hg @ 2003-10-21 08:21:00 by stephent] stephent parents: 1751 diff changeset	88
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	89 (defvar test-harness-verbose
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	90 (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	91 "*Non-nil means print messages describing progress of emacs-tester.")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	92
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	93 (defvar test-harness-unexpected-error-enter-debugger debug-on-error
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	94 "*Non-nil means enter debugger when an unexpected error occurs.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	95 Only applies interactively. Normally true if `debug-on-error' has been set.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	96 See also `test-harness-assertion-failure-enter-debugger' and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	97 `test-harness-unexpected-error-show-backtrace'.")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	98
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	99 (defvar test-harness-assertion-failure-enter-debugger debug-on-error
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	100 "*Non-nil means enter debugger when an assertion failure occurs.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	101 Only applies interactively. Normally true if `debug-on-error' has been set.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	102 See also `test-harness-unexpected-error-enter-debugger' and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	103 `test-harness-assertion-failure-show-backtrace'.")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	104
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	105 (defvar test-harness-unexpected-error-show-backtrace t
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	106 "*Non-nil means show backtrace upon unexpected error.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	107 Only applies when debugger is not entered. Normally true by default. See also
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	108 `test-harness-unexpected-error-enter-debugger' and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	109 `test-harness-assertion-failure-show-backtrace'.")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	110
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	111 (defvar test-harness-assertion-failure-show-backtrace stack-trace-on-error
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	112 "*Non-nil means show backtrace upon assertion failure.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	113 Only applies when debugger is not entered. Normally true if
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	114 `stack-trace-on-error' has been set. See also
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	115 `test-harness-assertion-failure-enter-debugger' and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	116 `test-harness-unexpected-error-show-backtrace'.")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	117
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	118 (defvar test-harness-file-results-alist nil
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	119 "Each element is a list (FILE SUCCESSES TESTS).
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	120 The order is the reverse of the order in which tests are run.
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	121
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	122 FILE is a string naming the test file.
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	123 SUCCESSES is a non-negative integer, the number of successes.
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	124 TESTS is a non-negative integer, the number of tests run.")
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	125
1425 74cb069b8417 [xemacs-hg @ 2003-04-23 15:42:44 by stephent] stephent parents: 1413 diff changeset	126 (defvar test-harness-risk-infloops nil
74cb069b8417 [xemacs-hg @ 2003-04-23 15:42:44 by stephent] stephent parents: 1413 diff changeset	127 "*Non-nil to run tests that may loop infinitely in buggy implementations.")
74cb069b8417 [xemacs-hg @ 2003-04-23 15:42:44 by stephent] stephent parents: 1413 diff changeset	128
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	129 (defvar test-harness-current-file nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	130
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	131 (defvar emacs-lisp-file-regexp (purecopy "\\.el\\'")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	132 "*Regexp which matches Emacs Lisp source files.")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	133
1751 5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	134 (defconst test-harness-file-summary-template
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	135 (format "%%-%ds %%%dd of %%%dd tests successful (%%3d%%%%)."
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	136 (length "byte-compiler-tests.el:") ; use the longest file name
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	137 5
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	138 5)
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	139 "Format for summary lines printed after each file is run.")
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	140
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	141 (defconst test-harness-null-summary-template
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	142 (format "%%-%ds No tests run."
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	143 (length "byte-compiler-tests.el:")) ; use the longest file name
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	144 "Format for \"No tests\" lines printed after a file is run.")
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	145
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	146 (defconst test-harness-aborted-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	147 (format "%%-%ds %%%dd tests completed (aborted)."
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	148 (length "byte-compiler-tests.el:") ; use the longest file name
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	149 5)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	150 "Format for summary lines printed after a test run on a file was aborted.")
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	151
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	152 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	153 (defun test-emacs-test-file (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	154 "Test a file of Lisp code named FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	155 The output file's name is made by appending `c' to the end of FILENAME."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	156 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	157 (let ((file buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	158 (file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	159 (file-dir nil))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	160 (and file
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	161 (eq (cdr (assq 'major-mode (buffer-local-variables)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	162 'emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	163 (setq file-name (file-name-nondirectory file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	164 file-dir (file-name-directory file)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	165 (list (read-file-name "Test file: " file-dir nil nil file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	166 ;; Expand now so we get the current buffer's defaults
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	167 (setq filename (expand-file-name filename))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	168
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	169 ;; If we're testing a file that's in a buffer and is modified, offer
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	170 ;; to save it first.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	171 (or noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	172 (let ((b (get-file-buffer (expand-file-name filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	173 (if (and b (buffer-modified-p b)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	174 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	175 (save-excursion (set-buffer b) (save-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	176
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	177 (if (or noninteractive test-harness-verbose)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	178 (message "Testing %s..." filename))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	179 (let ((test-harness-current-file filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	180 input-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	181 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	182 (setq input-buffer (get-buffer-create " Test Input"))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	183 (set-buffer input-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	184 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	185 (insert-file-contents filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	186 ;; Run hooks including the uncompression hook.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	187 ;; If they change the file name, then change it for the output also.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	188 (let ((buffer-file-name filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	189 (default-major-mode 'emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	190 (enable-local-eval nil))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	191 (normal-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	192 (setq filename buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	193 (test-harness-from-buffer input-buffer filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	194 (kill-buffer input-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	195 ))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	196
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	197 (defsubst test-harness-assertion-failure-do-debug (error-info)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	198 "Maybe enter debugger or display a backtrace on assertion failure.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	199 ERROR-INFO is a cons of the args (SIG . DATA) that were passed to `signal'.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	200 The debugger will be entered if noninteractive and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	201 `test-harness-unexpected-error-enter-debugger' is non-nil; else, a
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	202 backtrace will be displayed if `test-harness-unexpected-error-show-backtrace'
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	203 is non-nil."
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	204 (when (not test-harness-bug-expected)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	205 (cond ((and (not noninteractive)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	206 test-harness-assertion-failure-enter-debugger)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	207 (funcall debugger 'error error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	208 (test-harness-assertion-failure-show-backtrace
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	209 (backtrace nil t)))))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	210
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	211 (defsubst test-harness-unexpected-error-do-debug (error-info)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	212 "Maybe enter debugger or display a backtrace on unexpected error.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	213 ERROR-INFO is a cons of the args (SIG . DATA) that were passed to `signal'.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	214 The debugger will be entered if noninteractive and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	215 `test-harness-unexpected-error-enter-debugger' is non-nil; else, a
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	216 backtrace will be displayed if `test-harness-unexpected-error-show-backtrace'
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	217 is non-nil."
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	218 (when (not test-harness-bug-expected)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	219 (cond ((and (not noninteractive)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	220 test-harness-unexpected-error-enter-debugger)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	221 (funcall debugger 'error error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	222 (test-harness-unexpected-error-show-backtrace
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	223 (backtrace nil t)))))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	224
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	225 (defsubst test-harness-unexpected-error-condition-handler (error-info context-msg)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	226 "Condition handler for when unexpected errors occur.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	227 Useful in conjunction with `call-with-condition-handler'. ERROR-INFO is the
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	228 value passed to the condition handler. CONTEXT-MSG is a string indicating
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	229 the context in which the unexpected error occurred. A message is outputted
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	230 including CONTEXT-MSG in it, `unexpected-test-file-failures' is incremented,
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	231 and `test-harness-unexpected-error-do-debug' is called, which may enter the
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	232 debugger or output a backtrace, depending on the settings of
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	233 `test-harness-unexpected-error-enter-debugger' and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	234 `test-harness-unexpected-error-show-backtrace'.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	235
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	236 The function returns normally, which causes error-handling processing to
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	237 continue; if you want to catch the error, you also need to wrap everything
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	238 in `condition-case'. See also `test-harness-error-wrap', which does this
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	239 wrapping."
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	240 (incf unexpected-test-file-failures)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	241 (princ (format "Unexpected error %S while %s\n"
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	242 error-info context-msg))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	243 (message "Unexpected error %S while %s." error-info context-msg)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	244 (test-harness-unexpected-error-do-debug error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	245
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	246 (defmacro test-harness-error-wrap (context-msg abort-msg &rest body)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	247 "Wrap BODY so that unexpected errors are caught.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	248 The debugger will be entered if noninteractive and
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	249 `test-harness-unexpected-error-enter-debugger' is non-nil; else, a backtrace
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	250 will be displayed if `test-harness-unexpected-error-show-backtrace' is
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	251 non-nil. CONTEXT-MSG is displayed as part of a message shown before entering
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	252 the debugger or showing a backtrace, and ABORT-MSG, if non-nil, is displayed
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	253 afterwards. See "
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	254 `(condition-case nil
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	255 (call-with-condition-handler
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	256 #'(lambda (error-info)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	257 (test-harness-unexpected-error-condition-handler
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	258 error-info ,context-msg))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	259 #'(lambda ()
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	260 ,@body))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	261 (error ,(if abort-msg `(message ,abort-msg) nil))))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	262
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	263 (defun test-harness-read-from-buffer (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	264 "Read forms from BUFFER, and turn it into a lambda test form."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	265 (let ((body nil))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	266 (goto-char (point-min) buffer)
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	267 (condition-case nil
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	268 (call-with-condition-handler
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	269 #'(lambda (error-info)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	270 ;; end-of-file is expected, so don't output error or backtrace
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	271 ;; or enter debugger in this case.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	272 (unless (eq 'end-of-file (car error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	273 (test-harness-unexpected-error-condition-handler
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	274 error-info "reading forms from buffer")))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	275 #'(lambda ()
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	276 (while t
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	277 (setq body (cons (read buffer) body)))))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	278 (error nil))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	279 `(lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	280 (defvar passes)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	281 (defvar assertion-failures)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	282 (defvar no-error-failures)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	283 (defvar wrong-error-failures)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	284 (defvar missing-message-failures)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	285 (defvar other-failures)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	286
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	287 (defvar trick-optimizer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	288
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	289 ,@(nreverse body))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	290
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	291 (defun test-harness-from-buffer (inbuffer filename)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	292 "Run tests in buffer INBUFFER, visiting FILENAME."
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	293 (defvar trick-optimizer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	294 (let ((passes 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	295 (assertion-failures 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	296 (no-error-failures 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	297 (wrong-error-failures 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	298 (missing-message-failures 0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	299 (other-failures 0)
3471 3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	300 (unexpected-test-file-failures 0)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	301
973 ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	302 ;; #### perhaps this should be a defvar, and output at the very end
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	303 ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	304 ;; what stuff is needed, and ways to avoid using them
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	305 (skipped-test-reasons (make-hash-table :test 'equal))
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	306
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	307 (trick-optimizer nil)
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	308 (debug-on-error t)
5064 501b5e84f5a7 remove unused var in test-harness Ben Wing <ben@xemacs.org> parents: 5040 diff changeset	309 )
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	310 (with-output-to-temp-buffer "Test-Log"
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	311 (princ (format "Testing %s...\n\n" filename))
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	312
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	313 (defconst test-harness-failure-tag "FAIL")
aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	314 (defconst test-harness-success-tag "PASS")
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	315
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	316 ;;;;; BEGIN DEFINITION OF MACROS USEFUL IN TEST CODE
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	317
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	318 (defmacro Known-Bug-Expect-Failure (&rest body)
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	319 "Wrap a BODY that consists of tests that are known to fail.
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	320 This causes messages to be printed on failure indicating that this is expected,
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	321 and on success indicating that this is unexpected."
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	322 `(let ((test-harness-bug-expected t)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	323 (test-harness-failure-tag "KNOWN BUG")
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	324 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	325 ,@body))
4323 94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	326
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	327 (defmacro Known-Bug-Expect-Error (expected-error &rest body)
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	328 "Wrap a BODY that consists of tests that are known to trigger an error.
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	329 This causes messages to be printed on failure indicating that this is expected,
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	330 and on success indicating that this is unexpected."
4323 94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	331 (let ((quoted-body (if (= 1 (length body))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	332 `(quote ,(car body)) `(quote (progn ,@body)))))
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	333 `(let ((test-harness-bug-expected t)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	334 (test-harness-failure-tag "KNOWN BUG")
4323 94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	335 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	336 (condition-case error-info
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	337 (progn
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	338 (setq trick-optimizer (progn ,@body))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	339 (Print-Pass
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	340 "%S executed successfully, but expected error %S"
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	341 ,quoted-body
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	342 ',expected-error)
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	343 (incf passes))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	344 (,expected-error
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	345 (Print-Failure "%S ==> error %S, as expected"
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	346 ,quoted-body ',expected-error)
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	347 (incf no-error-failures))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	348 (error
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	349 (Print-Failure "%S ==> expected error %S, got error %S instead"
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	350 ,quoted-body ',expected-error error-info)
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	351 (incf wrong-error-failures))))))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	352
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	353 (defmacro Implementation-Incomplete-Expect-Failure (&rest body)
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	354 "Wrap a BODY containing tests that are known to fail due to incomplete code.
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	355 This causes messages to be printed on failure indicating that the
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	356 implementation is incomplete (and hence the failure is expected); and on
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	357 success indicating that this is unexpected."
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	358 `(let ((test-harness-bug-expected t)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	359 (test-harness-failure-tag "IMPLEMENTATION INCOMPLETE")
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	360 (test-harness-success-tag "PASS (FAILURE EXPECTED)"))
aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	361 ,@body))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	362
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	363 (defun Print-Failure (fmt &rest args)
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	364 (setq fmt (format "%s: %s" test-harness-failure-tag fmt))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	365 (if (noninteractive) (apply #'message fmt args))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	366 (princ (concat (apply #'format fmt args) "\n")))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	367
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	368 (defun Print-Pass (fmt &rest args)
1413 aa15a2bbba1a [xemacs-hg @ 2003-04-15 15:56:56 by stephent] stephent parents: 1231 diff changeset	369 (setq fmt (format "%s: %s" test-harness-success-tag fmt))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	370 (and test-harness-verbose
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	371 (princ (concat (apply #'format fmt args) "\n"))))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	372
973 ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	373 (defun Print-Skip (test reason &optional fmt &rest args)
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	374 (setq fmt (concat "SKIP: %S BECAUSE %S" fmt))
973 ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	375 (princ (concat (apply #'format fmt test reason args) "\n")))
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	376
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	377 (defmacro Skip-Test-Unless (condition reason description &rest body)
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	378 "Unless CONDITION is satisfied, skip test BODY.
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	379 REASON is a description of the condition failure, and must be unique (it
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	380 is used as a hash key). DESCRIPTION describes the tests that were skipped.
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	381 BODY is a sequence of expressions and may contain several tests."
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	382 `(if (not ,condition)
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	383 (let ((count (gethash ,reason skipped-test-reasons)))
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	384 (puthash ,reason (if (null count) 1 (1+ count))
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	385 skipped-test-reasons)
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	386 (Print-Skip ,description ,reason))
0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	387 ,@body))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	388
4747 294a86d29f99 Eliminate C asserts from c-tests. Stephen J. Turnbull <stephen@xemacs.org> parents: 4415 diff changeset	389 (defmacro Assert (assertion &optional failing-case description)
294a86d29f99 Eliminate C asserts from c-tests. Stephen J. Turnbull <stephen@xemacs.org> parents: 4415 diff changeset	390 "Test passes if ASSERTION is true.
4856 9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	391 Optional FAILING-CASE describes the particular failure. Optional
9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	392 DESCRIPTION describes the assertion; by default, the unevalated assertion
9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	393 expression is given. FAILING-CASE and DESCRIPTION are useful when Assert
9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	394 is used in a loop."
9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	395 (let ((description
9bf09492cff7 Clean up macro Assert Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	396 (or description `(quote ,assertion))))
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	397 `(condition-case nil
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	398 (call-with-condition-handler
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	399 #'(lambda (error-info)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	400 (if (eq 'cl-assertion-failed (car error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	401 (progn
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	402 (Print-Failure
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	403 (if ,failing-case
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	404 "Assertion failed: %S; failing case = %S"
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	405 "Assertion failed: %S")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	406 ,description ,failing-case)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	407 (incf assertion-failures)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	408 (test-harness-assertion-failure-do-debug error-info))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	409 (Print-Failure
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	410 (if ,failing-case
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	411 "%S ==> error: %S; failing case = %S"
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	412 "%S ==> error: %S")
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	413 ,description error-info ,failing-case)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	414 (incf other-failures)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	415 (test-harness-unexpected-error-do-debug error-info)))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	416 #'(lambda ()
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	417 (assert ,assertion)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	418 (Print-Pass "%S" ,description)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	419 (incf passes)))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	420 (cl-assertion-failed nil))))
2056 ab71063baf27 [xemacs-hg @ 2004-05-03 15:08:41 by james] james parents: 1761 diff changeset	421
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	422 ;;;;; BEGIN DEFINITION OF SPECIFIC KINDS OF ASSERT MACROS
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	423
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	424 (defmacro Assert-test (test testval expected &optional failing-case
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	425 description)
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	426 "Test passes if TESTVAL compares correctly to EXPECTED using TEST.
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	427 TEST should be a two-argument predicate (i.e. a function of two arguments
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	428 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	429 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	430 particular failure; any value given here will be concatenated with a phrase
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	431 describing the expected and actual values of the comparison. Optional
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	432 DESCRIPTION describes the assertion; by default, the unevalated comparison
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	433 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	434 is used in a loop."
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	435 (let* ((assertion `(,test ,testval ,expected))
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	436 (failmsg `(format "%S should be `%s' to %S but isn't"
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	437 ,testval ',test ,expected))
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	438 (failmsg2 (if failing-case `(concat
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	439 (format "%S, " ,failing-case)
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	440 ,failmsg)
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	441 failmsg)))
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	442 `(Assert ,assertion ,failmsg2 ,description)))
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	443
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	444 (defmacro Assert-test-not (test testval expected &optional failing-case
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	445 description)
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	446 "Test passes if TESTVAL does not compare correctly to EXPECTED using TEST.
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	447 TEST should be a two-argument predicate (i.e. a function of two arguments
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	448 that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=',
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	449 '>', 'file-newer-than-file-p' etc. Optional FAILING-CASE describes the
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	450 particular failure; any value given here will be concatenated with a phrase
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	451 describing the expected and actual values of the comparison. Optional
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	452 DESCRIPTION describes the assertion; by default, the unevalated comparison
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	453 expressions are given. FAILING-CASE and DESCRIPTION are useful when Assert
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	454 is used in a loop."
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	455 (let* ((assertion `(not (,test ,testval ,expected)))
4891 732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	456 (failmsg `(format "%S shouldn't be `%s' to %S but is"
732c35cdded8 fix failing-case output of Assert-test, add Assert-test-not Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	457 ,testval ',test ,expected))
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	458 (failmsg2 (if failing-case `(concat
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	459 (format "%S, " ,failing-case)
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	460 ,failmsg)
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	461 failmsg)))
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	462 `(Assert ,assertion ,failmsg2 ,description)))
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	463
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	464 ;; Specific versions of `Assert-test'. These are just convenience
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	465 ;; functions, functioning identically to `Assert-test', and duplicating
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	466 ;; the doc string for each would be too annoying.
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	467 (defmacro Assert-eq (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	468 description)
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	469 `(Assert-test eq ,testval ,expected ,failing-case ,description))
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	470 (defmacro Assert-eql (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	471 description)
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	472 `(Assert-test eql ,testval ,expected ,failing-case ,description))
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	473 (defmacro Assert-equal (testval expected &optional failing-case
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	474 description)
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	475 `(Assert-test equal ,testval ,expected ,failing-case ,description))
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	476 (defmacro Assert-equalp (testval expected &optional failing-case
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	477 description)
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	478 `(Assert-test equalp ,testval ,expected ,failing-case ,description))
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	479 (defmacro Assert-string= (testval expected &optional failing-case
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	480 description)
189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	481 `(Assert-test string= ,testval ,expected ,failing-case ,description))
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	482 (defmacro Assert= (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	483 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	484 `(Assert-test = ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	485 (defmacro Assert<= (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	486 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	487 `(Assert-test <= ,testval ,expected ,failing-case ,description))
4855 189fb67ca31a Create Assert-eq, Assert-equal, etc. Ben Wing <ben@xemacs.org> parents: 4845 diff changeset	488
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	489 ;; Specific versions of `Assert-test-not'. These are just convenience
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	490 ;; functions, functioning identically to `Assert-test-not', and
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	491 ;; duplicating the doc string for each would be too annoying.
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	492 (defmacro Assert-not-eq (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	493 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	494 `(Assert-test-not eq ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	495 (defmacro Assert-not-eql (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	496 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	497 `(Assert-test-not eql ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	498 (defmacro Assert-not-equal (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	499 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	500 `(Assert-test-not equal ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	501 (defmacro Assert-not-equalp (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	502 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	503 `(Assert-test-not equalp ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	504 (defmacro Assert-not-string= (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	505 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	506 `(Assert-test-not string= ,testval ,expected ,failing-case ,description))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	507 (defmacro Assert-not= (testval expected &optional failing-case
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	508 description)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	509 `(Assert-test-not = ,testval ,expected ,failing-case ,description))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	510
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	511 (defmacro Check-Error (expected-error &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	512 (let ((quoted-body (if (= 1 (length body))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	513 `(quote ,(car body)) `(quote (progn ,@body)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	514 `(condition-case error-info
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	515 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	516 (setq trick-optimizer (progn ,@body))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	517 (Print-Failure "%S executed successfully, but expected error %S"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	518 ,quoted-body
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	519 ',expected-error)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	520 (incf no-error-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	521 (,expected-error
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	522 (Print-Pass "%S ==> error %S, as expected"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	523 ,quoted-body ',expected-error)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	524 (incf passes))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	525 (error
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	526 (Print-Failure "%S ==> expected error %S, got error %S instead"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	527 ,quoted-body ',expected-error error-info)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	528 (incf wrong-error-failures)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	529
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	530 (defmacro Check-Error-Message (expected-error expected-error-regexp
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	531 &rest body)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	532 (let ((quoted-body (if (= 1 (length body))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	533 `(quote ,(car body)) `(quote (progn ,@body)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	534 `(condition-case error-info
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	535 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	536 (setq trick-optimizer (progn ,@body))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	537 (Print-Failure "%S executed successfully, but expected error %S"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	538 ,quoted-body ',expected-error)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	539 (incf no-error-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	540 (,expected-error
4199 3660d327399f [xemacs-hg @ 2007-10-01 08:07:39 by stephent] stephent parents: 3472 diff changeset	541 ;; #### Damn, this binding doesn't capture frobs, eg, for
3660d327399f [xemacs-hg @ 2007-10-01 08:07:39 by stephent] stephent parents: 3472 diff changeset	542 ;; invalid_argument() ... you only get the REASON. And for
3660d327399f [xemacs-hg @ 2007-10-01 08:07:39 by stephent] stephent parents: 3472 diff changeset	543 ;; wrong_type_argument(), there's no reason only FROBs.
3660d327399f [xemacs-hg @ 2007-10-01 08:07:39 by stephent] stephent parents: 3472 diff changeset	544 ;; If this gets fixed, fix tests in regexp-tests.el.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	545 (let ((error-message (second error-info)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	546 (if (string-match ,expected-error-regexp error-message)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	547 (progn
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	548 (Print-Pass "%S ==> error %S %S, as expected"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	549 ,quoted-body error-message ',expected-error)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	550 (incf passes))
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	551 (Print-Failure "%S ==> got error %S as expected, but error message %S did not match regexp %S"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	552 ,quoted-body ',expected-error error-message ,expected-error-regexp)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	553 (incf wrong-error-failures))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	554 (error
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	555 (Print-Failure "%S ==> expected error %S, got error %S instead"
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	556 ,quoted-body ',expected-error error-info)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	557 (incf wrong-error-failures)))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	558
3472 43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	559 ;; Do not use this with Silence-Message.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	560 (defmacro Check-Message (expected-message-regexp &rest body)
5069 14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	561 (let ((quoted-body (if (= 1 (length body))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	562 `(quote ,(car body))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	563 `(quote (progn ,@body)))))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	564 `(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice"
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	565 expected-message-regexp
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	566 (let ((messages ""))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	567 (defadvice message (around collect activate)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	568 (defvar messages)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	569 (let ((msg-string (apply 'format (ad-get-args 0))))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	570 (setq messages (concat messages msg-string))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	571 msg-string))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	572 (ignore-errors
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	573 (call-with-condition-handler
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	574 #'(lambda (error-info)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	575 (Print-Failure "%S ==> unexpected error %S"
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	576 ,quoted-body error-info)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	577 (incf other-failures)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	578 (test-harness-unexpected-error-do-debug error-info))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	579 #'(lambda ()
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	580 (setq trick-optimizer (progn ,@body))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	581 (if (string-match ,expected-message-regexp messages)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	582 (progn
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	583 (Print-Pass
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	584 "%S ==> value %S, message %S, matching %S, as expected"
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	585 ,quoted-body trick-optimizer messages
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	586 ',expected-message-regexp)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	587 (incf passes))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	588 (Print-Failure
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	589 "%S ==> value %S, message %S, NOT matching expected %S"
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	590 ,quoted-body trick-optimizer messages
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	591 ',expected-message-regexp)
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	592 (incf missing-message-failures)))))
14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	593 (ad-unadvise 'message)))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	594
3472 43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	595 ;; #### Perhaps this should override `message' itself, too?
43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	596 (defmacro Silence-Message (&rest body)
4323 94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	597 `(flet ((append-message (&rest args) ())
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	598 (clear-message (&rest args) ()))
94509abd0ef0 Commit a forgotten chunk of 4d0f773d5e21. Aidan Kehoe <kehoea@parhasard.net> parents: 4199 diff changeset	599 ,@body))
3472 43b4a54fbf66 [xemacs-hg @ 2006-06-24 14:30:36 by stephent] stephent parents: 3471 diff changeset	600
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	601 (defmacro Ignore-Ebola (&rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	602 `(let ((debug-issue-ebola-notices -42)) ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	603
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	604 (defun Int-to-Marker (pos)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	605 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	606 (set-buffer standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	607 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	608 (goto-char pos)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	609 (point-marker))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	610
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	611 (princ "Testing Interpreted Lisp\n\n")
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	612
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	613 (test-harness-error-wrap
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	614 "executing interpreted code"
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	615 "Test suite execution aborted."
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	616 (funcall (test-harness-read-from-buffer inbuffer)))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	617
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	618 (princ "\nTesting Compiled Lisp\n\n")
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	619
1758 90502933fb98 [xemacs-hg @ 2003-10-21 08:21:00 by stephent] stephent parents: 1751 diff changeset	620 (let (code
90502933fb98 [xemacs-hg @ 2003-10-21 08:21:00 by stephent] stephent parents: 1751 diff changeset	621 (test-harness-test-compiled t))
5040 3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	622 (test-harness-error-wrap
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	623 "byte-compiling code" nil
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	624 (setq code
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	625 ;; our lisp code is often intentionally dubious,
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	626 ;; so throw away _all_ the byte compiler warnings.
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	627 (letf (((symbol-function 'byte-compile-warn)
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	628 'ignore))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	629 (byte-compile (test-harness-read-from-buffer
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	630 inbuffer))))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	631 )
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	632
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	633 (test-harness-error-wrap "executing byte-compiled code"
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	634 "Test suite execution aborted."
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	635 (if code (funcall code)))
3daf9fc57cd4 fixes to test harness to allow backtracing/debugging of failures Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	636 )
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 446 diff changeset	637 (princ (format "\nSUMMARY for %s:\n" filename))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	638 (princ (format "\t%5d passes\n" passes))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	639 (princ (format "\t%5d assertion failures\n" assertion-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	640 (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	641 (princ (format "\t%5d wrong-error failures\n" wrong-error-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	642 (princ (format "\t%5d missing-message failures\n" missing-message-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	643 (princ (format "\t%5d other failures\n" other-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	644 (let* ((total (+ passes
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	645 assertion-failures
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	646 no-error-failures
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	647 wrong-error-failures
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	648 missing-message-failures
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	649 other-failures))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	650 (basename (file-name-nondirectory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	651 (summary-msg
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	652 (cond ((> unexpected-test-file-failures 0)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	653 (format test-harness-aborted-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	654 (concat basename ":") total))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	655 ((> total 0)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	656 (format test-harness-file-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	657 (concat basename ":")
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	658 passes total (/ (* 100 passes) total)))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	659 (t
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	660 (format test-harness-null-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	661 (concat basename ":")))))
973 ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	662 (reasons ""))
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	663 (maphash (lambda (key value)
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	664 (setq reasons
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	665 (concat reasons
1095 0d33547d9ed3 [xemacs-hg @ 2002-11-11 15:39:03 by stephent] stephent parents: 973 diff changeset	666 (format "\n %d tests skipped because %s."
973 ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	667 value key))))
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	668 skipped-test-reasons)
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	669 (when (> (length reasons) 1)
ea6a06f7bf2c [xemacs-hg @ 2002-08-22 14:56:23 by stephent] stephent parents: 928 diff changeset	670 (setq summary-msg (concat summary-msg reasons "
4415 bceb3e285ae7 case-tests.el: fix it on non-DEBUG_XEMACS; save standard-case-table, use it Aidan Kehoe <kehoea@parhasard.net> parents: 4366 diff changeset	671 It may be that XEmacs cannot find your installed packages. Set
bceb3e285ae7 case-tests.el: fix it on non-DEBUG_XEMACS; save standard-case-table, use it Aidan Kehoe <kehoea@parhasard.net> parents: 4366 diff changeset	672 EMACSPACKAGEPATH to the package hierarchy root or configure with
bceb3e285ae7 case-tests.el: fix it on non-DEBUG_XEMACS; save standard-case-table, use it Aidan Kehoe <kehoea@parhasard.net> parents: 4366 diff changeset	673 --package-path to enable the skipped tests.")))
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	674 (setq test-harness-file-results-alist
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	675 (cons (list filename passes total)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	676 test-harness-file-results-alist))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	677 (message "%s" summary-msg))
3471 3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	678 (when (> unexpected-test-file-failures 0)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	679 (setq unexpected-test-suite-failure-files
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	680 (cons filename unexpected-test-suite-failure-files))
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	681 (setq unexpected-test-suite-failures
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	682 (+ unexpected-test-suite-failures unexpected-test-file-failures))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	683 (message "Test suite execution failed unexpectedly."))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	684 (fmakunbound 'Assert)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	685 (fmakunbound 'Check-Error)
863 42375619fa45 [xemacs-hg @ 2002-06-04 06:03:59 by andyp] andyp parents: 826 diff changeset	686 (fmakunbound 'Check-Message)
42375619fa45 [xemacs-hg @ 2002-06-04 06:03:59 by andyp] andyp parents: 826 diff changeset	687 (fmakunbound 'Check-Error-Message)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	688 (fmakunbound 'Ignore-Ebola)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	689 (fmakunbound 'Int-to-Marker)
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	690 (and noninteractive
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	691 (message "%s" (buffer-substring-no-properties
1751 5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	692 nil nil "Test-Log")))
5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	693 )))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	694
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	695 (defvar test-harness-results-point-max nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	696 (defmacro displaying-emacs-test-results (&rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	697 `(let ((test-harness-results-point-max test-harness-results-point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	698 ;; Log the file name.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	699 (test-harness-log-file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	700 ;; Record how much is logged now.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	701 ;; We will display the log buffer if anything more is logged
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	702 ;; before the end of BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	703 (or test-harness-results-point-max
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	704 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	705 (set-buffer (get-buffer-create "Test-Log"))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	706 (setq test-harness-results-point-max (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	707 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	708 (condition-case error-info
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	709 (progn ,@body)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	710 (error
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	711 (test-harness-report-error error-info)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	712 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	713 ;; If there were compilation warnings, display them.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	714 (set-buffer "Test-Log")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	715 (if (= test-harness-results-point-max (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	716 nil
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	717 (if temp-buffer-show-function
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	718 (let ((show-buffer (get-buffer-create "Test-Log-Show")))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	719 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	720 (set-buffer show-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	721 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	722 (erase-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	723 (copy-to-buffer show-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	724 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	725 (goto-char test-harness-results-point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	726 (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	727 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	728 (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	729 (funcall temp-buffer-show-function show-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	730 (select-window
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	731 (prog1 (selected-window)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	732 (select-window (display-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	733 (goto-char test-harness-results-point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	734 (recenter 1)))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	735
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	736 (defun batch-test-emacs-1 (file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	737 (condition-case error-info
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	738 (progn (test-emacs-test-file file) t)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	739 (error
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	740 (princ ">>Error occurred processing ")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	741 (princ file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	742 (princ ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	743 (display-error error-info nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	744 (terpri)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	745 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	746
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	747 (defun batch-test-emacs ()
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	748 "Run `test-harness' on the files remaining on the command line.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	749 Use this from the command line, with `-batch';
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	750 it won't work in an interactive Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	751 Each file is processed even if an error occurred previously.
5069 14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	752 A directory can be given as well, and all files will be processed.
4948 8b230c53075b fix some tests in `make check', also add our own file-tests Ben Wing <ben@xemacs.org> parents: 4856 diff changeset	753 For example, invoke \"xemacs -batch -f batch-test-emacs tests\""
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	754 ;; command-line-args-left is what is left of the command line (from
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	755 ;; startup.el)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	756 (defvar command-line-args-left) ;Avoid 'free variable' warning
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	757 (defvar debug-issue-ebola-notices)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	758 (if (not noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	759 (error "`batch-test-emacs' is to be used only with -batch"))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	760 (let ((error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	761 (dolist (file command-line-args-left)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	762 (if (file-directory-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	763 (dolist (file-in-dir (directory-files file t))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	764 (when (and (string-match emacs-lisp-file-regexp file-in-dir)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	765 (not (or (auto-save-file-name-p file-in-dir)
5069 14f0dd1fabdb move test-harness to lisp/ directory so it gets byte-compiled Ben Wing <ben@xemacs.org> parents: 5064 diff changeset	766 (backup-file-name-p file-in-dir))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	767 (or (batch-test-emacs-1 file-in-dir)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	768 (setq error t))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	769 (or (batch-test-emacs-1 file)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	770 (setq error t))))
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	771 (let ((namelen 0)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	772 (succlen 0)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	773 (testlen 0)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	774 (results test-harness-file-results-alist))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	775 ;; compute maximum lengths of variable components of report
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	776 ;; probably should just use (length "byte-compiler-tests.el")
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	777 ;; and 5-place sizes -- this will also work for the file-by-file
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	778 ;; printing when Adrian's kludge gets reverted
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	779 (flet ((print-width (i)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	780 (let ((x 10) (y 1))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	781 (while (>= i x)
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	782 (setq x (* 10 x) y (1+ y)))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	783 y)))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	784 (while results
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	785 (let* ((head (car results))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	786 (nn (length (file-name-nondirectory (first head))))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	787 (ss (print-width (second head)))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	788 (tt (print-width (third head))))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	789 (when (> nn namelen) (setq namelen nn))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	790 (when (> ss succlen) (setq succlen ss))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	791 (when (> tt testlen) (setq testlen tt)))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	792 (setq results (cdr results))))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	793 ;; create format and print
1751 5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	794 (let ((results (reverse test-harness-file-results-alist)))
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	795 (while results
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	796 (let* ((head (car results))
1751 5a9a66ba67ca [xemacs-hg @ 2003-10-15 08:56:35 by stephent] stephent parents: 1722 diff changeset	797 (basename (file-name-nondirectory (first head)))
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	798 (nsucc (second head))
d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	799 (ntest (third head)))
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	800 (cond ((member (first head) unexpected-test-suite-failure-files)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	801 (message test-harness-aborted-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	802 (concat basename ":")
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	803 ntest))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	804 ((> ntest 0)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	805 (message test-harness-file-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	806 (concat basename ":")
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	807 nsucc
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	808 ntest
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	809 (/ (* 100 nsucc) ntest)))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	810 (t
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	811 (message test-harness-null-summary-template
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4891 diff changeset	812 (concat basename ":"))))
3471 3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	813 (setq results (cdr results)))))
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	814 (when (> unexpected-test-suite-failures 0)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	815 (message "\n***** There %s %d unexpected test suite %s in %s:"
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	816 (if (= unexpected-test-suite-failures 1) "was" "were")
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	817 unexpected-test-suite-failures
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	818 (if (= unexpected-test-suite-failures 1) "failure" "failures")
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	819 (if (= (length unexpected-test-suite-failure-files) 1)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	820 "file"
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	821 "files"))
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	822 (while unexpected-test-suite-failure-files
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	823 (let ((line (pop unexpected-test-suite-failure-files)))
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	824 (while (and (< (length line) 61)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	825 unexpected-test-suite-failure-files)
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	826 (setq line
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	827 (concat line " "
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	828 (pop unexpected-test-suite-failure-files))))
3b1f8220a65e [xemacs-hg @ 2006-06-24 13:50:19 by stephent] stephent parents: 2056 diff changeset	829 (message line)))))
1719 d9c4b6e360d8 [xemacs-hg @ 2003-09-27 06:51:16 by stephent] stephent parents: 1717 diff changeset	830 (message "\nDone")
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	831 (kill-emacs (if error 1 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	832
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	833 (provide 'test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	834
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	835 ;;; test-harness.el ends here

Mercurial > hg > xemacs-beta

annotate lisp/test-harness.el @ 5075:868a9ffcc37b