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