Mercurial > hg > xemacs-beta
annotate lisp/test-harness.el @ 5157:1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-18 Ben Wing <ben@xemacs.org>
* diagnose.el (show-memory-usage):
Rewrite to take into account API changes in memory-usage functions.
src/ChangeLog addition:
2010-03-18 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (disksave_object_finalization_1):
* alloc.c (lisp_object_storage_size):
* alloc.c (listu):
* alloc.c (listn):
* alloc.c (Fobject_memory_usage_stats):
* alloc.c (compute_memusage_stats_length):
* alloc.c (Fobject_memory_usage):
* alloc.c (Ftotal_object_memory_usage):
* alloc.c (malloced_storage_size):
* alloc.c (common_init_alloc_early):
* alloc.c (reinit_alloc_objects_early):
* alloc.c (reinit_alloc_early):
* alloc.c (init_alloc_once_early):
* alloc.c (syms_of_alloc):
* alloc.c (reinit_vars_of_alloc):
* buffer.c:
* buffer.c (struct buffer_stats):
* buffer.c (compute_buffer_text_usage):
* buffer.c (compute_buffer_usage):
* buffer.c (buffer_memory_usage):
* buffer.c (buffer_objects_create):
* buffer.c (syms_of_buffer):
* buffer.c (vars_of_buffer):
* console-impl.h (struct console_methods):
* dynarr.c (Dynarr_memory_usage):
* emacs.c (main_1):
* events.c (clear_event_resource):
* extents.c:
* extents.c (compute_buffer_extent_usage):
* extents.c (extent_objects_create):
* extents.h:
* faces.c:
* faces.c (compute_face_cachel_usage):
* faces.c (face_objects_create):
* faces.h:
* general-slots.h:
* glyphs.c:
* glyphs.c (compute_glyph_cachel_usage):
* glyphs.c (glyph_objects_create):
* glyphs.h:
* lisp.h:
* lisp.h (struct usage_stats):
* lrecord.h:
* lrecord.h (enum lrecord_type):
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lrecord.h (INIT_LISP_OBJECT):
* lrecord.h (INIT_MODULE_LISP_OBJECT):
* lrecord.h (UNDEF_LISP_OBJECT):
* lrecord.h (UNDEF_MODULE_LISP_OBJECT):
* lrecord.h (DECLARE_LISP_OBJECT):
* lrecord.h (DECLARE_MODULE_API_LISP_OBJECT):
* lrecord.h (DECLARE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (syms_of_lstream):
* lstream.c (vars_of_lstream):
* marker.c:
* marker.c (compute_buffer_marker_usage):
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
* mule-charset.c:
* mule-charset.c (struct charset_stats):
* mule-charset.c (compute_charset_usage):
* mule-charset.c (charset_memory_usage):
* mule-charset.c (mule_charset_objects_create):
* mule-charset.c (syms_of_mule_charset):
* mule-charset.c (vars_of_mule_charset):
* redisplay.c:
* redisplay.c (compute_rune_dynarr_usage):
* redisplay.c (compute_display_block_dynarr_usage):
* redisplay.c (compute_glyph_block_dynarr_usage):
* redisplay.c (compute_display_line_dynarr_usage):
* redisplay.c (compute_line_start_cache_dynarr_usage):
* redisplay.h:
* scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage):
* scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage):
* scrollbar-x.c (x_compute_scrollbar_instance_usage):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h:
* symbols.c:
* symbols.c (reinit_symbol_objects_early):
* symbols.c (init_symbols_once_early):
* symbols.c (reinit_symbols_early):
* symbols.c (defsymbol_massage_name_1):
* symsinit.h:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_getprop):
* ui-gtk.c (emacs_gtk_object_putprop):
* ui-gtk.c (ui_gtk_objects_create):
* unicode.c (compute_from_unicode_table_size_1):
* unicode.c (compute_to_unicode_table_size_1):
* unicode.c (compute_from_unicode_table_size):
* unicode.c (compute_to_unicode_table_size):
* window.c:
* window.c (struct window_stats):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
* window.c (window_memory_usage):
* window.c (window_objects_create):
* window.c (syms_of_window):
* window.c (vars_of_window):
* window.h:
Redo memory-usage mechanism, make it general; add way of dynamically
initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to
CONSOLE_HAS_METHOD().
(1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for
specifying that a Lisp object type has a particular method or
property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH,
OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY.
Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to
specify them (getprop, putprop, remprop, plist, disksave) now
instead use the dynamic-method mechanism. The main benefit of
this is that new methods or properties can be added without
requiring that the declaration statements of all existing methods
be modified. We have to make the `struct lrecord_implementation'
non-const, but I don't think this should have any effect on speed --
the only possible method that's really speed-critical is the
mark method, and we already extract those out into a separate
(non-const) array for increased cache locality.
Object methods need to be reinitialized after pdump, so we put
them in separate functions such as face_objects_create(),
extent_objects_create() and call them appropriately from emacs.c
The only current object property (`memusage_stats_list') that
objects can specify is a Lisp object and gets staticpro()ed so it
only needs to be set during dump time, but because it references
symbols that might not exist in a syms_of_() function, we
initialize it in vars_of_(). There is also an object property
(`num_extra_memusage_stats') that is automatically initialized based
on `memusage_stats_list'; we do that in reinit_vars_of_alloc(),
which is called after all vars_of_() functions are called.
`disksaver' method was renamed `disksave' to correspond with the
name normally given to the function (e.g. disksave_lstream()).
(2) Generalize the memory-usage mechanism in `buffer-memory-usage',
`window-memory-usage', `charset-memory-usage' into an object-type-
specific mechanism called by a single function
`object-memory-usage'. (Former function `object-memory-usage'
renamed to `total-object-memory-usage'). Generalize the mechanism
of different "slices" so that we can have different "classes" of
memory described and different "slices" onto each class; `t'
separates classes, `nil' separates slices. Currently we have
three classes defined: the memory of an object itself,
non-Lisp-object memory associated with the object (e.g. arrays or
dynarrs stored as fields in the object), and Lisp-object memory
associated with the object (other internal Lisp objects stored in
the object). This isn't completely finished yet and we might need
to further separate the "other internal Lisp objects" class into
two classes.
The memory-usage mechanism uses a `struct usage_stats' (renamed
from `struct overhead_stats') to describe a malloc-view onto a set
of allocated memory (listing how much was requested and various
types of overhead) and a more general `struct generic_usage_stats'
(with a `struct usage_stats' in it) to hold all statistics about
object memory. `struct generic_usage_stats' contains an array of
32 Bytecounts, which are statistics of unspecified semantics. The
intention is that individual types declare a corresponding struct
(e.g. `struct window_stats') with the same structure but with
specific fields in place of the array, corresponding to specific
statistics. The number of such statistics is an object property
computed from the list of tags (Lisp symbols describing the
statistics) stored in `memusage_stats_list'. The idea here is to
allow particular object types to customize the number and
semantics of the statistics where completely avoiding consing.
This doesn't matter so much yet, but the intention is to have the
memory usage of all objects computed at the end of GC, at the same
time as other statistics are currently computed. The values for
all statistics for a single type would be added up to compute
aggregate values for all objects of a specific type. To make this
efficient, we can't allow any memory allocation at all.
(3) Create some additional functions for creating lists that
specify the elements directly as args rather than indirectly through
an array: listn() (number of args given), listu() (list terminated
by Qunbound).
(4) Delete a bit of remaining unused C window_config stuff, also
unused lrecord_type_popup_data.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Thu, 18 Mar 2010 10:50:06 -0500 |
| parents | 0f66906b6e37 |
| children | ecdd1daab447 |
| rev | line source |
|---|---|
| 428 | 1 ;; test-harness.el --- Run Emacs Lisp test suites. |
| 2 | |
| 1751 | 3 ;;; Copyright (C) 1998, 2002, 2003 Free Software Foundation, Inc. |
| 4856 | 4 ;;; Copyright (C) 2002, 2010 Ben Wing. |
| 428 | 5 |
| 6 ;; Author: Martin Buchholz | |
| 1761 | 7 ;; Maintainer: Stephen J. Turnbull <stephen@xemacs.org> |
| 428 | 8 ;; Keywords: testing |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
| 12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 13 ;; under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 20 ;; General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 23 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 25 ;; Boston, MA 02111-1307, USA. | |
| 26 | |
| 27 ;;; Synched up with: Not in FSF. | |
| 28 | |
| 29 ;;; Commentary: | |
| 30 | |
| 31 ;;; A test suite harness for testing XEmacs. | |
| 32 ;;; The actual tests are in other files in this directory. | |
| 33 ;;; Basically you just create files of emacs-lisp, and use the | |
| 1095 | 34 ;;; Assert, Check-Error, Check-Message, and Check-Error-Message functions |
| 35 ;;; to create tests. See `test-harness-from-buffer' below. | |
| 36 ;;; Don't suppress tests just because they're due to known bugs not yet | |
| 1413 | 37 ;;; fixed -- use the Known-Bug-Expect-Failure and |
| 38 ;;; Implementation-Incomplete-Expect-Failure wrapper macros to mark them. | |
| 1095 | 39 ;;; A lot of the tests we run push limits; suppress Ebola message with the |
| 40 ;;; Ignore-Ebola wrapper macro. | |
| 3472 | 41 ;;; Some noisy code will call `message'. Output from `message' can be |
| 42 ;;; suppressed with the Silence-Message macro. Functions that are known to | |
| 43 ;;; issue messages include `write-region', `find-tag', `tag-loop-continue', | |
| 44 ;;; `insert', and `mark-whole-buffer'. N.B. The Silence-Message macro | |
| 45 ;;; currently does not suppress the newlines printed by `message'. | |
| 46 ;;; Definitely do not use Silence-Message with Check-Message. | |
| 47 ;;; In general it should probably only be used on code that prepares for a | |
| 48 ;;; test, not on tests. | |
| 1095 | 49 ;;; |
| 428 | 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 | 52 ;;; which is run for you by the `make check' target in the top-level Makefile. |
| 53 | |
| 54 (require 'bytecomp) | |
| 55 | |
| 3471 | 56 (defvar unexpected-test-suite-failures 0 |
| 57 "Cumulative number of unexpected failures since test-harness was loaded. | |
| 58 | |
| 59 \"Unexpected failures\" are those caught by a generic handler established | |
| 60 outside of the test context. As such they involve an abort of the test | |
| 61 suite for the file being tested. | |
| 62 | |
| 63 They often occur during preparation of a test or recording of the results. | |
| 64 For example, an executable used to generate test data might not be present | |
| 65 on the system, or a system error might occur while reading a data file.") | |
| 66 | |
| 67 (defvar unexpected-test-suite-failure-files nil | |
| 68 "List of test files causing unexpected failures.") | |
| 69 | |
| 70 ;; Declared for dynamic scope; _do not_ initialize here. | |
| 71 (defvar unexpected-test-file-failures) | |
| 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 | 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 | 88 |
| 428 | 89 (defvar test-harness-verbose |
| 90 (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) | |
| 91 "*Non-nil means print messages describing progress of emacs-tester.") | |
| 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 | 118 (defvar test-harness-file-results-alist nil |
| 119 "Each element is a list (FILE SUCCESSES TESTS). | |
| 120 The order is the reverse of the order in which tests are run. | |
| 121 | |
| 122 FILE is a string naming the test file. | |
| 123 SUCCESSES is a non-negative integer, the number of successes. | |
| 124 TESTS is a non-negative integer, the number of tests run.") | |
| 125 | |
| 1425 | 126 (defvar test-harness-risk-infloops nil |
| 127 "*Non-nil to run tests that may loop infinitely in buggy implementations.") | |
| 128 | |
| 428 | 129 (defvar test-harness-current-file nil) |
| 130 | |
| 131 (defvar emacs-lisp-file-regexp (purecopy "\\.el\\'") | |
| 132 "*Regexp which matches Emacs Lisp source files.") | |
| 133 | |
| 1751 | 134 (defconst test-harness-file-summary-template |
| 135 (format "%%-%ds %%%dd of %%%dd tests successful (%%3d%%%%)." | |
| 136 (length "byte-compiler-tests.el:") ; use the longest file name | |
| 137 5 | |
| 138 5) | |
| 139 "Format for summary lines printed after each file is run.") | |
| 140 | |
| 141 (defconst test-harness-null-summary-template | |
| 142 (format "%%-%ds No tests run." | |
| 143 (length "byte-compiler-tests.el:")) ; use the longest file name | |
| 144 "Format for \"No tests\" lines printed after a file is run.") | |
| 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 | 152 ;;;###autoload |
| 153 (defun test-emacs-test-file (filename) | |
| 154 "Test a file of Lisp code named FILENAME. | |
| 155 The output file's name is made by appending `c' to the end of FILENAME." | |
| 156 (interactive | |
| 157 (let ((file buffer-file-name) | |
| 158 (file-name nil) | |
| 159 (file-dir nil)) | |
| 160 (and file | |
| 161 (eq (cdr (assq 'major-mode (buffer-local-variables))) | |
| 162 'emacs-lisp-mode) | |
| 163 (setq file-name (file-name-nondirectory file) | |
| 164 file-dir (file-name-directory file))) | |
| 165 (list (read-file-name "Test file: " file-dir nil nil file-name)))) | |
| 166 ;; Expand now so we get the current buffer's defaults | |
| 167 (setq filename (expand-file-name filename)) | |
| 168 | |
| 169 ;; If we're testing a file that's in a buffer and is modified, offer | |
| 170 ;; to save it first. | |
| 171 (or noninteractive | |
| 172 (let ((b (get-file-buffer (expand-file-name filename)))) | |
| 173 (if (and b (buffer-modified-p b) | |
| 174 (y-or-n-p (format "save buffer %s first? " (buffer-name b)))) | |
| 175 (save-excursion (set-buffer b) (save-buffer))))) | |
| 176 | |
| 177 (if (or noninteractive test-harness-verbose) | |
| 178 (message "Testing %s..." filename)) | |
| 179 (let ((test-harness-current-file filename) | |
| 180 input-buffer) | |
| 181 (save-excursion | |
| 182 (setq input-buffer (get-buffer-create " *Test Input*")) | |
| 183 (set-buffer input-buffer) | |
| 184 (erase-buffer) | |
| 185 (insert-file-contents filename) | |
| 186 ;; Run hooks including the uncompression hook. | |
| 187 ;; If they change the file name, then change it for the output also. | |
| 188 (let ((buffer-file-name filename) | |
| 189 (default-major-mode 'emacs-lisp-mode) | |
| 190 (enable-local-eval nil)) | |
| 191 (normal-mode) | |
| 192 (setq filename buffer-file-name))) | |
| 193 (test-harness-from-buffer input-buffer filename) | |
| 194 (kill-buffer input-buffer) | |
| 195 )) | |
| 196 | |
| 5110 | 197 (defsubst test-harness-backtrace () |
| 198 "Display a reasonable-size backtrace." | |
| 199 (let ((print-escape-newlines t) | |
| 200 (print-length 50)) | |
| 201 (backtrace nil t))) | |
| 202 | |
|
5040
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
203 (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
|
204 "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
|
205 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
|
206 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
|
207 `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
|
208 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
|
209 is non-nil." |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
210 (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
|
211 (cond ((and (not noninteractive) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
212 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
|
213 (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
|
214 (test-harness-assertion-failure-show-backtrace |
| 5110 | 215 (test-harness-backtrace))))) |
|
5040
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
216 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
217 (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
|
218 "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
|
219 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
|
220 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
|
221 `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
|
222 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
|
223 is non-nil." |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
224 (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
|
225 (cond ((and (not noninteractive) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
226 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
|
227 (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
|
228 (test-harness-unexpected-error-show-backtrace |
| 5110 | 229 (test-harness-backtrace))))) |
|
5040
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
230 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
231 (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
|
232 "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
|
233 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
|
234 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
|
235 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
|
236 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
|
237 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
|
238 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
|
239 `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
|
240 `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
|
241 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
242 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
|
243 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
|
244 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
|
245 wrapping." |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
246 (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
|
247 (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
|
248 error-info context-msg)) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
249 (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
|
250 (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
|
251 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
252 (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
|
253 "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
|
254 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
|
255 `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
|
256 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
|
257 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
|
258 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
|
259 afterwards. See " |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
260 `(condition-case nil |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
261 (call-with-condition-handler |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
262 #'(lambda (error-info) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
263 (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
|
264 error-info ,context-msg)) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
265 #'(lambda () |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
266 ,@body)) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
267 (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
|
268 |
| 428 | 269 (defun test-harness-read-from-buffer (buffer) |
| 270 "Read forms from BUFFER, and turn it into a lambda test form." | |
| 271 (let ((body nil)) | |
| 272 (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
|
273 (condition-case nil |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
274 (call-with-condition-handler |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
275 #'(lambda (error-info) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
276 ;; 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
|
277 ;; 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
|
278 (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
|
279 (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
|
280 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
|
281 #'(lambda () |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
282 (while t |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
283 (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
|
284 (error nil)) |
| 428 | 285 `(lambda () |
| 286 (defvar passes) | |
| 287 (defvar assertion-failures) | |
| 288 (defvar no-error-failures) | |
| 289 (defvar wrong-error-failures) | |
| 290 (defvar missing-message-failures) | |
| 291 (defvar other-failures) | |
| 292 | |
| 293 (defvar trick-optimizer) | |
| 294 | |
| 295 ,@(nreverse body)))) | |
| 296 | |
| 297 (defun test-harness-from-buffer (inbuffer filename) | |
| 298 "Run tests in buffer INBUFFER, visiting FILENAME." | |
| 299 (defvar trick-optimizer) | |
| 300 (let ((passes 0) | |
| 301 (assertion-failures 0) | |
| 302 (no-error-failures 0) | |
| 303 (wrong-error-failures 0) | |
| 304 (missing-message-failures 0) | |
| 305 (other-failures 0) | |
| 3471 | 306 (unexpected-test-file-failures 0) |
| 428 | 307 |
| 973 | 308 ;; #### perhaps this should be a defvar, and output at the very end |
| 309 ;; OTOH, this way AC types can use a null EMACSPACKAGEPATH to find | |
| 310 ;; what stuff is needed, and ways to avoid using them | |
| 311 (skipped-test-reasons (make-hash-table :test 'equal)) | |
| 312 | |
| 428 | 313 (trick-optimizer nil) |
| 826 | 314 (debug-on-error t) |
|
5064
501b5e84f5a7
remove unused var in test-harness
Ben Wing <ben@xemacs.org>
parents:
5040
diff
changeset
|
315 ) |
| 428 | 316 (with-output-to-temp-buffer "*Test-Log*" |
| 826 | 317 (princ (format "Testing %s...\n\n" filename)) |
| 1095 | 318 |
| 1413 | 319 (defconst test-harness-failure-tag "FAIL") |
| 320 (defconst test-harness-success-tag "PASS") | |
| 1095 | 321 |
|
4891
732c35cdded8
fix failing-case output of Assert-test, add Assert-test-not
Ben Wing <ben@xemacs.org>
parents:
4856
diff
changeset
|
322 ;;;;; 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
|
323 |
| 1095 | 324 (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
|
325 "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
|
326 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
|
327 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
|
328 `(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
|
329 (test-harness-failure-tag "KNOWN BUG") |
| 1413 | 330 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) |
| 331 ,@body)) | |
|
4323
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
332 |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
333 (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
|
334 "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
|
335 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
|
336 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
|
337 (let ((quoted-body (if (= 1 (length body)) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
338 `(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
|
339 `(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
|
340 (test-harness-failure-tag "KNOWN BUG") |
|
4323
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
341 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
342 (condition-case error-info |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
343 (progn |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
344 (setq trick-optimizer (progn ,@body)) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
345 (Print-Pass |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
346 "%S executed successfully, but expected error %S" |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
347 ,quoted-body |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
348 ',expected-error) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
349 (incf passes)) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
350 (,expected-error |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
351 (Print-Failure "%S ==> error %S, as expected" |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
352 ,quoted-body ',expected-error) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
353 (incf no-error-failures)) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
354 (error |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
355 (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
|
356 ,quoted-body ',expected-error error-info) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
357 (incf wrong-error-failures)))))) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
358 |
| 1413 | 359 (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
|
360 "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
|
361 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
|
362 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
|
363 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
|
364 `(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
|
365 (test-harness-failure-tag "IMPLEMENTATION INCOMPLETE") |
| 1413 | 366 (test-harness-success-tag "PASS (FAILURE EXPECTED)")) |
| 367 ,@body)) | |
| 826 | 368 |
| 369 (defun Print-Failure (fmt &rest args) | |
| 1413 | 370 (setq fmt (format "%s: %s" test-harness-failure-tag fmt)) |
| 826 | 371 (if (noninteractive) (apply #'message fmt args)) |
| 372 (princ (concat (apply #'format fmt args) "\n"))) | |
| 373 | |
| 374 (defun Print-Pass (fmt &rest args) | |
| 1413 | 375 (setq fmt (format "%s: %s" test-harness-success-tag fmt)) |
| 826 | 376 (and test-harness-verbose |
| 377 (princ (concat (apply #'format fmt args) "\n")))) | |
| 378 | |
| 973 | 379 (defun Print-Skip (test reason &optional fmt &rest args) |
| 1095 | 380 (setq fmt (concat "SKIP: %S BECAUSE %S" fmt)) |
| 973 | 381 (princ (concat (apply #'format fmt test reason args) "\n"))) |
| 382 | |
| 1095 | 383 (defmacro Skip-Test-Unless (condition reason description &rest body) |
| 384 "Unless CONDITION is satisfied, skip test BODY. | |
| 385 REASON is a description of the condition failure, and must be unique (it | |
| 386 is used as a hash key). DESCRIPTION describes the tests that were skipped. | |
| 387 BODY is a sequence of expressions and may contain several tests." | |
| 388 `(if (not ,condition) | |
| 389 (let ((count (gethash ,reason skipped-test-reasons))) | |
| 390 (puthash ,reason (if (null count) 1 (1+ count)) | |
| 391 skipped-test-reasons) | |
| 392 (Print-Skip ,description ,reason)) | |
| 393 ,@body)) | |
| 428 | 394 |
|
4747
294a86d29f99
Eliminate C asserts from c-tests.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4415
diff
changeset
|
395 (defmacro Assert (assertion &optional failing-case description) |
|
294a86d29f99
Eliminate C asserts from c-tests.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4415
diff
changeset
|
396 "Test passes if ASSERTION is true. |
| 4856 | 397 Optional FAILING-CASE describes the particular failure. Optional |
| 398 DESCRIPTION describes the assertion; by default, the unevalated assertion | |
| 399 expression is given. FAILING-CASE and DESCRIPTION are useful when Assert | |
| 400 is used in a loop." | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
401 (let ((test-assertion assertion) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
402 (negated nil)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
403 (when (and (listp test-assertion) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
404 (= 2 (length test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
405 (memq (car test-assertion) '(not null))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
406 (setq test-assertion (cadr test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
407 (setq negated t)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
408 (when (and (listp test-assertion) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
409 (= 3 (length test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
410 (member (car test-assertion) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
411 '(eq eql equal equalp = string= < <= > >=))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
412 (let* ((test (car test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
413 (testval (second test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
414 (expected (third test-assertion)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
415 (failmsg `(format ,(if negated |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
416 "%S shouldn't be `%s' to %S but is" |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
417 "%S should be `%s' to %S but isn't") |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
418 ,testval ',test ,expected))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
419 (setq failing-case (if failing-case |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
420 `(concat |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
421 (format "%S, " ,failing-case) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
422 ,failmsg) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
5110
diff
changeset
|
423 failmsg))))) |
| 4856 | 424 (let ((description |
| 425 (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
|
426 `(condition-case nil |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
427 (call-with-condition-handler |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
428 #'(lambda (error-info) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
429 (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
|
430 (progn |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
431 (Print-Failure |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
432 (if ,failing-case |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
433 "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
|
434 "Assertion failed: %S") |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
435 ,description ,failing-case) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
436 (incf assertion-failures) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
437 (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
|
438 (Print-Failure |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
439 (if ,failing-case |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
440 "%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
|
441 "%S ==> error: %S") |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
442 ,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
|
443 (incf other-failures) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
444 (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
|
445 #'(lambda () |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
446 (assert ,assertion) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
447 (Print-Pass "%S" ,description) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
448 (incf passes))) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
449 (cl-assertion-failed nil)))) |
| 2056 | 450 |
| 428 | 451 (defmacro Check-Error (expected-error &rest body) |
| 452 (let ((quoted-body (if (= 1 (length body)) | |
| 453 `(quote ,(car body)) `(quote (progn ,@body))))) | |
| 454 `(condition-case error-info | |
| 455 (progn | |
| 456 (setq trick-optimizer (progn ,@body)) | |
| 826 | 457 (Print-Failure "%S executed successfully, but expected error %S" |
| 428 | 458 ,quoted-body |
| 826 | 459 ',expected-error) |
| 428 | 460 (incf no-error-failures)) |
| 461 (,expected-error | |
| 826 | 462 (Print-Pass "%S ==> error %S, as expected" |
| 463 ,quoted-body ',expected-error) | |
| 428 | 464 (incf passes)) |
| 465 (error | |
| 826 | 466 (Print-Failure "%S ==> expected error %S, got error %S instead" |
| 467 ,quoted-body ',expected-error error-info) | |
| 428 | 468 (incf wrong-error-failures))))) |
| 469 | |
| 826 | 470 (defmacro Check-Error-Message (expected-error expected-error-regexp |
| 471 &rest body) | |
| 428 | 472 (let ((quoted-body (if (= 1 (length body)) |
| 473 `(quote ,(car body)) `(quote (progn ,@body))))) | |
| 474 `(condition-case error-info | |
| 475 (progn | |
| 476 (setq trick-optimizer (progn ,@body)) | |
| 826 | 477 (Print-Failure "%S executed successfully, but expected error %S" |
| 478 ,quoted-body ',expected-error) | |
| 428 | 479 (incf no-error-failures)) |
| 480 (,expected-error | |
| 4199 | 481 ;; #### Damn, this binding doesn't capture frobs, eg, for |
| 482 ;; invalid_argument() ... you only get the REASON. And for | |
| 483 ;; wrong_type_argument(), there's no reason only FROBs. | |
| 484 ;; If this gets fixed, fix tests in regexp-tests.el. | |
| 428 | 485 (let ((error-message (second error-info))) |
| 486 (if (string-match ,expected-error-regexp error-message) | |
| 487 (progn | |
| 826 | 488 (Print-Pass "%S ==> error %S %S, as expected" |
| 489 ,quoted-body error-message ',expected-error) | |
| 428 | 490 (incf passes)) |
| 826 | 491 (Print-Failure "%S ==> got error %S as expected, but error message %S did not match regexp %S" |
| 492 ,quoted-body ',expected-error error-message ,expected-error-regexp) | |
| 428 | 493 (incf wrong-error-failures)))) |
| 494 (error | |
| 826 | 495 (Print-Failure "%S ==> expected error %S, got error %S instead" |
| 496 ,quoted-body ',expected-error error-info) | |
| 428 | 497 (incf wrong-error-failures))))) |
| 498 | |
| 3472 | 499 ;; Do not use this with Silence-Message. |
| 428 | 500 (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
|
501 (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
|
502 `(quote ,(car body)) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
503 `(quote (progn ,@body))))) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
504 `(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
|
505 expected-message-regexp |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
506 (let ((messages "")) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
507 (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
|
508 (defvar messages) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
509 (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
|
510 (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
|
511 msg-string)) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
512 (ignore-errors |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
513 (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
|
514 #'(lambda (error-info) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
515 (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
|
516 ,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
|
517 (incf other-failures) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
518 (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
|
519 #'(lambda () |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
520 (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
|
521 (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
|
522 (progn |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
523 (Print-Pass |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
524 "%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
|
525 ,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
|
526 ',expected-message-regexp) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
527 (incf passes)) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
528 (Print-Failure |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
529 "%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
|
530 ,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
|
531 ',expected-message-regexp) |
|
14f0dd1fabdb
move test-harness to lisp/ directory so it gets byte-compiled
Ben Wing <ben@xemacs.org>
parents:
5064
diff
changeset
|
532 (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
|
533 (ad-unadvise 'message))))) |
| 428 | 534 |
| 3472 | 535 ;; #### Perhaps this should override `message' itself, too? |
| 536 (defmacro Silence-Message (&rest body) | |
|
4323
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
537 `(flet ((append-message (&rest args) ()) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
538 (clear-message (&rest args) ())) |
|
94509abd0ef0
Commit a forgotten chunk of 4d0f773d5e21.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4199
diff
changeset
|
539 ,@body)) |
| 3472 | 540 |
| 428 | 541 (defmacro Ignore-Ebola (&rest body) |
| 542 `(let ((debug-issue-ebola-notices -42)) ,@body)) | |
| 543 | |
| 544 (defun Int-to-Marker (pos) | |
| 545 (save-excursion | |
| 546 (set-buffer standard-output) | |
| 547 (save-excursion | |
| 548 (goto-char pos) | |
| 549 (point-marker)))) | |
| 550 | |
| 551 (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
|
552 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
553 (test-harness-error-wrap |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
554 "executing interpreted code" |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
555 "Test suite execution aborted." |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
556 (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
|
557 |
| 428 | 558 (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
|
559 |
| 1758 | 560 (let (code |
| 561 (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
|
562 (test-harness-error-wrap |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
563 "byte-compiling code" nil |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
564 (setq code |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
565 ;; 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
|
566 ;; 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
|
567 (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
|
568 'ignore)) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
569 (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
|
570 inbuffer)))) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
571 ) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
572 |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
573 (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
|
574 "Test suite execution aborted." |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
575 (if code (funcall code))) |
|
3daf9fc57cd4
fixes to test harness to allow backtracing/debugging of failures
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
576 ) |
| 826 | 577 (princ (format "\nSUMMARY for %s:\n" filename)) |
| 428 | 578 (princ (format "\t%5d passes\n" passes)) |
| 579 (princ (format "\t%5d assertion failures\n" assertion-failures)) | |
| 580 (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures)) | |
| 581 (princ (format "\t%5d wrong-error failures\n" wrong-error-failures)) | |
| 582 (princ (format "\t%5d missing-message failures\n" missing-message-failures)) | |
| 583 (princ (format "\t%5d other failures\n" other-failures)) | |
| 584 (let* ((total (+ passes | |
| 585 assertion-failures | |
| 586 no-error-failures | |
| 587 wrong-error-failures | |
| 588 missing-message-failures | |
| 589 other-failures)) | |
| 590 (basename (file-name-nondirectory filename)) | |
| 591 (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
|
592 (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
|
593 (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
|
594 (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
|
595 ((> total 0) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
596 (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
|
597 (concat basename ":") |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
598 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
|
599 (t |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
600 (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
|
601 (concat basename ":"))))) |
| 973 | 602 (reasons "")) |
| 603 (maphash (lambda (key value) | |
| 604 (setq reasons | |
| 605 (concat reasons | |
| 1095 | 606 (format "\n %d tests skipped because %s." |
| 973 | 607 value key)))) |
| 608 skipped-test-reasons) | |
| 609 (when (> (length reasons) 1) | |
| 610 (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
|
611 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
|
612 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
|
613 --package-path to enable the skipped tests."))) |
| 1719 | 614 (setq test-harness-file-results-alist |
| 615 (cons (list filename passes total) | |
| 616 test-harness-file-results-alist)) | |
| 428 | 617 (message "%s" summary-msg)) |
| 3471 | 618 (when (> unexpected-test-file-failures 0) |
| 619 (setq unexpected-test-suite-failure-files | |
| 620 (cons filename unexpected-test-suite-failure-files)) | |
| 621 (setq unexpected-test-suite-failures | |
| 622 (+ unexpected-test-suite-failures unexpected-test-file-failures)) | |
| 428 | 623 (message "Test suite execution failed unexpectedly.")) |
| 624 (fmakunbound 'Assert) | |
| 625 (fmakunbound 'Check-Error) | |
| 863 | 626 (fmakunbound 'Check-Message) |
| 627 (fmakunbound 'Check-Error-Message) | |
| 428 | 628 (fmakunbound 'Ignore-Ebola) |
| 629 (fmakunbound 'Int-to-Marker) | |
| 1719 | 630 (and noninteractive |
| 631 (message "%s" (buffer-substring-no-properties | |
| 1751 | 632 nil nil "*Test-Log*"))) |
| 633 ))) | |
| 428 | 634 |
| 635 (defvar test-harness-results-point-max nil) | |
| 636 (defmacro displaying-emacs-test-results (&rest body) | |
| 637 `(let ((test-harness-results-point-max test-harness-results-point-max)) | |
| 638 ;; Log the file name. | |
| 639 (test-harness-log-file) | |
| 640 ;; Record how much is logged now. | |
| 641 ;; We will display the log buffer if anything more is logged | |
| 642 ;; before the end of BODY. | |
| 643 (or test-harness-results-point-max | |
| 644 (save-excursion | |
| 645 (set-buffer (get-buffer-create "*Test-Log*")) | |
| 646 (setq test-harness-results-point-max (point-max)))) | |
| 647 (unwind-protect | |
| 648 (condition-case error-info | |
| 649 (progn ,@body) | |
| 650 (error | |
| 651 (test-harness-report-error error-info))) | |
| 652 (save-excursion | |
| 653 ;; If there were compilation warnings, display them. | |
| 654 (set-buffer "*Test-Log*") | |
| 655 (if (= test-harness-results-point-max (point-max)) | |
| 656 nil | |
| 657 (if temp-buffer-show-function | |
| 658 (let ((show-buffer (get-buffer-create "*Test-Log-Show*"))) | |
| 659 (save-excursion | |
| 660 (set-buffer show-buffer) | |
| 661 (setq buffer-read-only nil) | |
| 662 (erase-buffer)) | |
| 663 (copy-to-buffer show-buffer | |
| 664 (save-excursion | |
| 665 (goto-char test-harness-results-point-max) | |
| 666 (forward-line -1) | |
| 667 (point)) | |
| 668 (point-max)) | |
| 669 (funcall temp-buffer-show-function show-buffer)) | |
| 670 (select-window | |
| 671 (prog1 (selected-window) | |
| 672 (select-window (display-buffer (current-buffer))) | |
| 673 (goto-char test-harness-results-point-max) | |
| 674 (recenter 1))))))))) | |
| 675 | |
| 676 (defun batch-test-emacs-1 (file) | |
| 677 (condition-case error-info | |
| 678 (progn (test-emacs-test-file file) t) | |
| 679 (error | |
| 680 (princ ">>Error occurred processing ") | |
| 681 (princ file) | |
| 682 (princ ": ") | |
| 683 (display-error error-info nil) | |
| 684 (terpri) | |
| 685 nil))) | |
| 686 | |
| 687 (defun batch-test-emacs () | |
| 688 "Run `test-harness' on the files remaining on the command line. | |
| 689 Use this from the command line, with `-batch'; | |
| 690 it won't work in an interactive Emacs. | |
| 691 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
|
692 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
|
693 For example, invoke \"xemacs -batch -f batch-test-emacs tests\"" |
| 428 | 694 ;; command-line-args-left is what is left of the command line (from |
| 695 ;; startup.el) | |
| 696 (defvar command-line-args-left) ;Avoid 'free variable' warning | |
| 697 (defvar debug-issue-ebola-notices) | |
| 698 (if (not noninteractive) | |
| 699 (error "`batch-test-emacs' is to be used only with -batch")) | |
| 700 (let ((error nil)) | |
| 701 (dolist (file command-line-args-left) | |
| 702 (if (file-directory-p file) | |
| 703 (dolist (file-in-dir (directory-files file t)) | |
| 704 (when (and (string-match emacs-lisp-file-regexp file-in-dir) | |
| 705 (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
|
706 (backup-file-name-p file-in-dir)))) |
| 428 | 707 (or (batch-test-emacs-1 file-in-dir) |
| 708 (setq error t)))) | |
| 709 (or (batch-test-emacs-1 file) | |
| 710 (setq error t)))) | |
| 1719 | 711 (let ((namelen 0) |
| 712 (succlen 0) | |
| 713 (testlen 0) | |
| 714 (results test-harness-file-results-alist)) | |
| 715 ;; compute maximum lengths of variable components of report | |
| 716 ;; probably should just use (length "byte-compiler-tests.el") | |
| 717 ;; and 5-place sizes -- this will also work for the file-by-file | |
| 718 ;; printing when Adrian's kludge gets reverted | |
| 719 (flet ((print-width (i) | |
| 720 (let ((x 10) (y 1)) | |
| 721 (while (>= i x) | |
| 722 (setq x (* 10 x) y (1+ y))) | |
| 723 y))) | |
| 724 (while results | |
| 725 (let* ((head (car results)) | |
| 726 (nn (length (file-name-nondirectory (first head)))) | |
| 727 (ss (print-width (second head))) | |
| 728 (tt (print-width (third head)))) | |
| 729 (when (> nn namelen) (setq namelen nn)) | |
| 730 (when (> ss succlen) (setq succlen ss)) | |
| 731 (when (> tt testlen) (setq testlen tt))) | |
| 732 (setq results (cdr results)))) | |
| 733 ;; create format and print | |
| 1751 | 734 (let ((results (reverse test-harness-file-results-alist))) |
| 1719 | 735 (while results |
| 736 (let* ((head (car results)) | |
| 1751 | 737 (basename (file-name-nondirectory (first head))) |
| 1719 | 738 (nsucc (second head)) |
| 739 (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
|
740 (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
|
741 (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
|
742 (concat basename ":") |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
743 ntest)) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
744 ((> ntest 0) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
745 (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
|
746 (concat basename ":") |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
747 nsucc |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
748 ntest |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
749 (/ (* 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
|
750 (t |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4891
diff
changeset
|
751 (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
|
752 (concat basename ":")))) |
| 3471 | 753 (setq results (cdr results))))) |
| 754 (when (> unexpected-test-suite-failures 0) | |
| 755 (message "\n***** There %s %d unexpected test suite %s in %s:" | |
| 756 (if (= unexpected-test-suite-failures 1) "was" "were") | |
| 757 unexpected-test-suite-failures | |
| 758 (if (= unexpected-test-suite-failures 1) "failure" "failures") | |
| 759 (if (= (length unexpected-test-suite-failure-files) 1) | |
| 760 "file" | |
| 761 "files")) | |
| 762 (while unexpected-test-suite-failure-files | |
| 763 (let ((line (pop unexpected-test-suite-failure-files))) | |
| 764 (while (and (< (length line) 61) | |
| 765 unexpected-test-suite-failure-files) | |
| 766 (setq line | |
| 767 (concat line " " | |
| 768 (pop unexpected-test-suite-failure-files)))) | |
| 769 (message line))))) | |
| 1719 | 770 (message "\nDone") |
| 428 | 771 (kill-emacs (if error 1 0)))) |
| 772 | |
| 773 (provide 'test-harness) | |
| 774 | |
| 775 ;;; test-harness.el ends here |