29876
|
1 ;;; esh-test --- Eshell test suite
|
|
2
|
29934
|
3 ;; Copyright (C) 1999, 2000 Free Software Foundation
|
29876
|
4
|
32526
|
5 ;; Author: John Wiegley <johnw@gnu.org>
|
|
6
|
29876
|
7 ;; This file is part of GNU Emacs.
|
|
8
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
12 ;; any later version.
|
|
13
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17 ;; GNU General Public License for more details.
|
|
18
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
23
|
|
24 (provide 'esh-test)
|
|
25
|
|
26 (eval-when-compile (require 'esh-maint))
|
|
27
|
|
28 (defgroup eshell-test nil
|
|
29 "This module is meant to ensure that Eshell is working correctly."
|
|
30 :tag "Eshell test suite"
|
|
31 :group 'eshell)
|
|
32
|
|
33 ;;; Commentary:
|
|
34
|
|
35 ;; The purpose of this module is to verify that Eshell works as
|
|
36 ;; expected. To run it on your system, use the command
|
|
37 ;; \\[eshell-test].
|
|
38
|
|
39 ;;; Code:
|
|
40
|
|
41 (require 'esh-mode)
|
|
42
|
|
43 ;;; User Variables:
|
|
44
|
|
45 (defface eshell-test-ok-face
|
|
46 '((((class color) (background light)) (:foreground "Green" :bold t))
|
|
47 (((class color) (background dark)) (:foreground "Green" :bold t)))
|
|
48 "*The face used to highlight OK result strings."
|
|
49 :group 'eshell-test)
|
|
50
|
|
51 (defface eshell-test-failed-face
|
|
52 '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
|
|
53 (((class color) (background dark)) (:foreground "OrangeRed" :bold t))
|
|
54 (t (:bold t)))
|
|
55 "*The face used to highlight FAILED result strings."
|
|
56 :group 'eshell-test)
|
|
57
|
|
58 (defcustom eshell-show-usage-metrics nil
|
|
59 "*If non-nil, display different usage metrics for each Eshell command."
|
|
60 :set (lambda (symbol value)
|
|
61 (if value
|
|
62 (add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
|
|
63 (remove-hook 'eshell-mode-hook 'eshell-show-usage-metrics))
|
|
64 (set symbol value))
|
|
65 :type '(choice (const :tag "No metrics" nil)
|
|
66 (const :tag "Cons cells consumed" t)
|
|
67 (const :tag "Time elapsed" 0))
|
|
68 :group 'eshell-test)
|
|
69
|
|
70 ;;; Code:
|
|
71
|
|
72 (eval-when-compile
|
|
73 (defvar test-buffer))
|
|
74
|
|
75 (defun eshell-insert-command (text &optional func)
|
|
76 "Insert a command at the end of the buffer."
|
|
77 (goto-char eshell-last-output-end)
|
|
78 (insert-and-inherit text)
|
|
79 (funcall (or func 'eshell-send-input)))
|
|
80
|
|
81 (defun eshell-match-result (regexp)
|
|
82 "Insert a command at the end of the buffer."
|
|
83 (goto-char eshell-last-input-end)
|
|
84 (looking-at regexp))
|
|
85
|
|
86 (defun eshell-command-result-p (text regexp &optional func)
|
|
87 "Insert a command at the end of the buffer."
|
|
88 (eshell-insert-command text func)
|
|
89 (eshell-match-result regexp))
|
|
90
|
|
91 (defvar eshell-test-failures nil)
|
|
92
|
|
93 (defun eshell-run-test (module funcsym label command)
|
|
94 "Test whether FORM evaluates to a non-nil value."
|
|
95 (when (let ((sym (intern-soft (concat "eshell-" (symbol-name module)))))
|
|
96 (or (memq sym (eshell-subgroups 'eshell))
|
|
97 (eshell-using-module sym)))
|
|
98 (with-current-buffer test-buffer
|
|
99 (insert-before-markers
|
|
100 (format "%-70s " (substring label 0 (min 70 (length label)))))
|
|
101 (insert-before-markers " ....")
|
|
102 (eshell-redisplay))
|
|
103 (let ((truth (eval command)))
|
|
104 (with-current-buffer test-buffer
|
|
105 (delete-backward-char 6)
|
|
106 (insert-before-markers
|
|
107 "[" (let (str)
|
|
108 (if truth
|
|
109 (progn
|
|
110 (setq str " OK ")
|
|
111 (put-text-property 0 6 'face
|
|
112 'eshell-test-ok-face str))
|
|
113 (setq str "FAILED")
|
|
114 (setq eshell-test-failures (1+ eshell-test-failures))
|
|
115 (put-text-property 0 6 'face
|
|
116 'eshell-test-failed-face str))
|
|
117 str) "]")
|
|
118 (add-text-properties (line-beginning-position) (point)
|
|
119 (list 'test-func funcsym))
|
|
120 (eshell-redisplay)))))
|
|
121
|
|
122 (defun eshell-test-goto-func ()
|
|
123 "Jump to the function that defines a particular test."
|
|
124 (interactive)
|
|
125 (let ((fsym (get-text-property (point) 'test-func)))
|
|
126 (when fsym
|
|
127 (let* ((def (symbol-function fsym))
|
|
128 (library (locate-library (symbol-file fsym)))
|
|
129 (name (substring (symbol-name fsym)
|
|
130 (length "eshell-test--")))
|
|
131 (inhibit-redisplay t))
|
|
132 (find-file library)
|
|
133 (goto-char (point-min))
|
|
134 (re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
|
|
135 name))
|
|
136 (beginning-of-line)))))
|
|
137
|
|
138 (defun eshell-run-one-test (&optional arg)
|
|
139 "Jump to the function that defines a particular test."
|
|
140 (interactive "P")
|
|
141 (let ((fsym (get-text-property (point) 'test-func)))
|
|
142 (when fsym
|
|
143 (beginning-of-line)
|
|
144 (delete-region (point) (line-end-position))
|
|
145 (let ((test-buffer (current-buffer)))
|
|
146 (set-buffer (let ((inhibit-redisplay t))
|
|
147 (save-window-excursion (eshell t))))
|
|
148 (funcall fsym)
|
|
149 (unless arg
|
|
150 (kill-buffer (current-buffer)))))))
|
|
151
|
|
152 ;;;###autoload
|
|
153 (defun eshell-test (&optional arg)
|
|
154 "Test Eshell to verify that it works as expected."
|
|
155 (interactive "P")
|
|
156 (let* ((begin (eshell-time-to-seconds (current-time)))
|
|
157 (test-buffer (get-buffer-create "*eshell test*")))
|
|
158 (set-buffer (let ((inhibit-redisplay t))
|
|
159 (save-window-excursion (eshell t))))
|
|
160 (with-current-buffer test-buffer
|
|
161 (erase-buffer)
|
|
162 (setq major-mode 'eshell-test-mode)
|
|
163 (setq mode-name "EShell Test")
|
|
164 (set (make-local-variable 'eshell-test-failures) 0)
|
|
165 (local-set-key [(control ?c) (control ?c)] 'eshell-test-goto-func)
|
|
166 (local-set-key [(control ?c) (control ?r)] 'eshell-run-one-test)
|
|
167 (local-set-key [(control ?m)] 'eshell-test-goto-func)
|
|
168 (local-set-key [return] 'eshell-test-goto-func)
|
|
169
|
|
170 (insert "Testing Eshell under "
|
|
171 (format "GNU Emacs %s (%s%s)"
|
|
172 emacs-version
|
|
173 system-configuration
|
|
174 (cond ((featurep 'motif) ", Motif")
|
|
175 ((featurep 'x-toolkit) ", X toolkit")
|
33020
|
176 (t ""))))
|
29876
|
177 (switch-to-buffer test-buffer)
|
|
178 (delete-other-windows))
|
33020
|
179 (eshell-for funcname (sort (all-completions "eshell-test--"
|
|
180 obarray 'functionp)
|
|
181 'string-lessp)
|
29876
|
182 (with-current-buffer test-buffer
|
|
183 (insert "\n"))
|
|
184 (funcall (intern-soft funcname)))
|
|
185 (with-current-buffer test-buffer
|
|
186 (insert (format "\n\n--- %s --- (completed in %d seconds)\n"
|
|
187 (current-time-string)
|
|
188 (- (eshell-time-to-seconds (current-time))
|
|
189 begin)))
|
|
190 (message "Eshell test suite completed: %s failure%s"
|
|
191 (if (> eshell-test-failures 0)
|
|
192 (number-to-string eshell-test-failures)
|
|
193 "No")
|
|
194 (if (= eshell-test-failures 1) "" "s"))))
|
|
195 (goto-char eshell-last-output-end)
|
|
196 (unless arg
|
|
197 (kill-buffer (current-buffer))))
|
|
198
|
|
199
|
|
200 (defvar eshell-metric-before-command 0)
|
|
201 (defvar eshell-metric-after-command 0)
|
|
202
|
|
203 (defun eshell-show-usage-metrics ()
|
|
204 "If run at Eshell mode startup, metrics are shown after each command."
|
|
205 (set (make-local-variable 'eshell-metric-before-command)
|
|
206 (if (eq eshell-show-usage-metrics t)
|
|
207 0
|
|
208 (current-time)))
|
|
209 (set (make-local-variable 'eshell-metric-after-command)
|
|
210 (if (eq eshell-show-usage-metrics t)
|
|
211 0
|
|
212 (current-time)))
|
|
213
|
|
214 (make-local-hook 'eshell-pre-command-hook)
|
|
215 (add-hook 'eshell-pre-command-hook
|
|
216 (function
|
|
217 (lambda ()
|
|
218 (setq eshell-metric-before-command
|
|
219 (if (eq eshell-show-usage-metrics t)
|
|
220 (car (memory-use-counts))
|
|
221 (current-time))))) nil t)
|
|
222
|
|
223 (make-local-hook 'eshell-post-command-hook)
|
|
224 (add-hook 'eshell-post-command-hook
|
|
225 (function
|
|
226 (lambda ()
|
|
227 (setq eshell-metric-after-command
|
|
228 (if (eq eshell-show-usage-metrics t)
|
|
229 (car (memory-use-counts))
|
|
230 (current-time)))
|
|
231 (eshell-interactive-print
|
|
232 (concat
|
|
233 (int-to-string
|
|
234 (if (eq eshell-show-usage-metrics t)
|
|
235 (- eshell-metric-after-command
|
|
236 eshell-metric-before-command 7)
|
|
237 (- (eshell-time-to-seconds
|
|
238 eshell-metric-after-command)
|
|
239 (eshell-time-to-seconds
|
|
240 eshell-metric-before-command))))
|
|
241 "\n"))))
|
|
242 nil t))
|
|
243
|
|
244 ;;; esh-test.el ends here
|