|
272
|
1 ;; test-emacs.el --- Run Emacs Lisp test suites.
|
|
|
2
|
|
|
3 ;;; Copyright (C) 1998 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Martin Buchholz
|
|
|
6 ;; Keywords: testing
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF
|
|
|
26
|
|
|
27 (defvar test-emacs-verbose
|
|
|
28 (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
|
|
|
29 "*Non-nil means print messages describing progress of emacs-tester.")
|
|
|
30
|
|
|
31 (defvar test-emacs-current-file nil)
|
|
|
32
|
|
|
33 (defvar emacs-lisp-file-regexp (purecopy "\\.el$")
|
|
|
34 "*Regexp which matches Emacs Lisp source files.")
|
|
|
35
|
|
|
36 (defun test-emacs-test-file (filename)
|
|
|
37 "Test a file of Lisp code named FILENAME.
|
|
|
38 The output file's name is made by appending `c' to the end of FILENAME."
|
|
|
39 ;; (interactive "fTest file: ")
|
|
|
40 (interactive
|
|
|
41 (let ((file buffer-file-name)
|
|
|
42 (file-name nil)
|
|
|
43 (file-dir nil))
|
|
|
44 (and file
|
|
|
45 (eq (cdr (assq 'major-mode (buffer-local-variables)))
|
|
|
46 'emacs-lisp-mode)
|
|
|
47 (setq file-name (file-name-nondirectory file)
|
|
|
48 file-dir (file-name-directory file)))
|
|
|
49 (list (read-file-name "Test file: " file-dir nil nil file-name))))
|
|
|
50 ;; Expand now so we get the current buffer's defaults
|
|
|
51 (setq filename (expand-file-name filename))
|
|
|
52
|
|
|
53 ;; If we're testing a file that's in a buffer and is modified, offer
|
|
|
54 ;; to save it first.
|
|
|
55 (or noninteractive
|
|
|
56 (let ((b (get-file-buffer (expand-file-name filename))))
|
|
|
57 (if (and b (buffer-modified-p b)
|
|
|
58 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
|
|
|
59 (save-excursion (set-buffer b) (save-buffer)))))
|
|
|
60
|
|
|
61 (if (or noninteractive test-emacs-verbose)
|
|
|
62 (message "Testing %s..." filename))
|
|
|
63 (let ((test-emacs-current-file filename)
|
|
|
64 input-buffer)
|
|
|
65 (save-excursion
|
|
|
66 (setq input-buffer (get-buffer-create " *Test Input*"))
|
|
|
67 (set-buffer input-buffer)
|
|
|
68 (erase-buffer)
|
|
|
69 (insert-file-contents filename)
|
|
|
70 ;; Run hooks including the uncompression hook.
|
|
|
71 ;; If they change the file name, then change it for the output also.
|
|
|
72 (let ((buffer-file-name filename)
|
|
|
73 (default-major-mode 'emacs-lisp-mode)
|
|
|
74 (enable-local-eval nil))
|
|
|
75 (normal-mode)
|
|
|
76 (setq filename buffer-file-name)))
|
|
|
77 (test-emacs-from-buffer input-buffer filename)
|
|
|
78 (kill-buffer input-buffer)
|
|
|
79 ))
|
|
|
80
|
|
|
81 (defun test-emacs-read-from-buffer (buffer)
|
|
|
82 "Read forms from BUFFER, and turn it into a lambda test form."
|
|
|
83 (let ((body nil))
|
|
|
84 (goto-char (point-min) buffer)
|
|
|
85 (condition-case nil
|
|
|
86 (while t
|
|
|
87 (setq body (cons (read inbuffer) body)))
|
|
|
88 (error nil))
|
|
|
89 `(lambda ()
|
|
|
90 (defvar passes)
|
|
|
91 (defvar assertion-failures)
|
|
|
92 (defvar other-failures)
|
|
|
93 ,@(nreverse body))))
|
|
|
94
|
|
|
95 (defun test-emacs-from-buffer (inbuffer filename)
|
|
|
96 "Run tests in buffer INBUFFER, visiting FILENAME."
|
|
|
97 (let ((passes 0)
|
|
|
98 (assertion-failures 0)
|
|
|
99 (other-failures 0))
|
|
|
100 (with-output-to-temp-buffer "*Test-Log*"
|
|
|
101 (defmacro Assert (assertion)
|
|
|
102 `(condition-case error
|
|
|
103 (progn
|
|
|
104 (assert ,assertion)
|
|
|
105 (princ (format "PASS: %S" (quote ,assertion)))
|
|
|
106 (terpri)
|
|
|
107 (incf passes))
|
|
|
108 (cl-assertion-failed
|
|
|
109 (princ (format "Assertion failed: %S" (quote ,assertion)))
|
|
|
110 (terpri)
|
|
|
111 (incf assertion-failures))
|
|
|
112 (t (princ "Error during test execution:\n\t")
|
|
|
113 (display-error error nil)
|
|
|
114 (terpri)
|
|
|
115 (incf other-failures)
|
|
|
116 )))
|
|
|
117
|
|
|
118 (princ "Testing Interpreted Lisp\n\n")
|
|
|
119 (funcall (test-emacs-read-from-buffer inbuffer))
|
|
|
120 (princ "\nTesting Compiled Lisp\n\n")
|
|
|
121 (funcall (byte-compile (test-emacs-read-from-buffer inbuffer)))
|
|
|
122 (princ (format
|
|
|
123 "\nSUMMARY: %d passes, %d assertion failures, %d other failures\n"
|
|
|
124 passes
|
|
|
125 assertion-failures
|
|
|
126 other-failures))
|
|
|
127 (let* ((total (+ passes assertion-failures other-failures))
|
|
|
128 (basename (file-name-nondirectory filename))
|
|
|
129 (summary-msg
|
|
|
130 (if (> total 0)
|
|
|
131 (format "%s: %d of %d (%d%%) tests successful."
|
|
|
132 basename passes total (/ (* 100 passes) total))
|
|
|
133 (format "%s: No tests run" basename))))
|
|
|
134 (message "%s" summary-msg))
|
|
|
135 (fmakunbound 'Assert))))
|
|
|
136
|
|
|
137 (defvar test-emacs-results-point-max nil)
|
|
|
138 (defmacro displaying-emacs-test-results (&rest body)
|
|
|
139 `(let ((test-emacs-results-point-max test-emacs-results-point-max))
|
|
|
140 ;; Log the file name.
|
|
|
141 (test-emacs-log-file)
|
|
|
142 ;; Record how much is logged now.
|
|
|
143 ;; We will display the log buffer if anything more is logged
|
|
|
144 ;; before the end of BODY.
|
|
|
145 (or test-emacs-results-point-max
|
|
|
146 (save-excursion
|
|
|
147 (set-buffer (get-buffer-create "*Test-Log*"))
|
|
|
148 (setq test-emacs-results-point-max (point-max))))
|
|
|
149 (unwind-protect
|
|
|
150 (condition-case error-info
|
|
|
151 (progn ,@body)
|
|
|
152 (error
|
|
|
153 (test-emacs-report-error error-info)))
|
|
|
154 (save-excursion
|
|
|
155 ;; If there were compilation warnings, display them.
|
|
|
156 (set-buffer "*Test-Log*")
|
|
|
157 (if (= test-emacs-results-point-max (point-max))
|
|
|
158 nil
|
|
|
159 (if temp-buffer-show-function
|
|
|
160 (let ((show-buffer (get-buffer-create "*Test-Log-Show*")))
|
|
|
161 (save-excursion
|
|
|
162 (set-buffer show-buffer)
|
|
|
163 (setq buffer-read-only nil)
|
|
|
164 (erase-buffer))
|
|
|
165 (copy-to-buffer show-buffer
|
|
|
166 (save-excursion
|
|
|
167 (goto-char test-emacs-results-point-max)
|
|
|
168 (forward-line -1)
|
|
|
169 (point))
|
|
|
170 (point-max))
|
|
|
171 (funcall temp-buffer-show-function show-buffer))
|
|
|
172 (select-window
|
|
|
173 (prog1 (selected-window)
|
|
|
174 (select-window (display-buffer (current-buffer)))
|
|
|
175 (goto-char test-emacs-results-point-max)
|
|
|
176 (recenter 1)))))))))
|
|
|
177
|
|
|
178 (defun batch-test-emacs-1 (file)
|
|
|
179 (condition-case err
|
|
|
180 (progn (test-emacs-test-file file) t)
|
|
|
181 (error
|
|
|
182 (princ ">>Error occurred processing ")
|
|
|
183 (princ file)
|
|
|
184 (princ ": ")
|
|
|
185 (display-error err nil)
|
|
|
186 (terpri)
|
|
|
187 nil)))
|
|
|
188
|
|
|
189 (defun batch-test-emacs ()
|
|
|
190 "Run `test-emacs' on the files remaining on the command line.
|
|
|
191 Use this from the command line, with `-batch';
|
|
|
192 it won't work in an interactive Emacs.
|
|
|
193 Each file is processed even if an error occurred previously.
|
|
|
194 For example, invoke \"xemacs -batch -f batch-test-emacs tests/*.el\""
|
|
|
195 ;; command-line-args-left is what is left of the command line (from
|
|
|
196 ;; startup.el)
|
|
|
197 (defvar command-line-args-left) ;Avoid 'free variable' warning
|
|
|
198 (if (not noninteractive)
|
|
|
199 (error "`batch-test-emacs' is to be used only with -batch"))
|
|
|
200 (let ((error nil)
|
|
|
201 (debug-issue-ebola-notices 0))
|
|
|
202 (loop for file in command-line-args-left
|
|
|
203 do
|
|
|
204 (if (file-directory-p (expand-file-name file))
|
|
|
205 (let ((files (directory-files file))
|
|
|
206 source)
|
|
|
207 (while files
|
|
|
208 (if (and (string-match emacs-lisp-file-regexp (car files))
|
|
|
209 (not (auto-save-file-name-p (car files)))
|
|
|
210 (setq source (expand-file-name
|
|
|
211 (car files)
|
|
|
212 file))
|
|
|
213 (if (null (batch-test-emacs-1 source))
|
|
|
214 (setq error t)))
|
|
|
215 (setq files (cdr files)))))
|
|
|
216 (if (null (batch-test-emacs-1 file))
|
|
|
217 (setq error t))))
|
|
|
218 (message "Done")
|
|
|
219 (kill-emacs (if error 1 0))))
|
