38414
|
1 ;;; esh-test.el --- Eshell test suite
|
29876
|
2
|
95619
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
|
106815
|
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc.
|
29876
|
5
|
32526
|
6 ;; Author: John Wiegley <johnw@gnu.org>
|
|
7
|
29876
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
94661
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
29876
|
11 ;; it under the terms of the GNU General Public License as published by
|
94661
|
12 ;; the Free Software Foundation, either version 3 of the License, or
|
|
13 ;; (at your option) any later version.
|
29876
|
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
|
94661
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
29876
|
22
|
|
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
|
87088
|
31 (eval-when-compile
|
|
32 (require 'eshell)
|
|
33 (require 'esh-util))
|
29876
|
34 (require 'esh-mode)
|
|
35
|
87088
|
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
|
29876
|
41 ;;; User Variables:
|
|
42
|
63533
|
43 (defface eshell-test-ok
|
29876
|
44 '((((class color) (background light)) (:foreground "Green" :bold t))
|
|
45 (((class color) (background dark)) (:foreground "Green" :bold t)))
|
|
46 "*The face used to highlight OK result strings."
|
|
47 :group 'eshell-test)
|
104783
|
48 (define-obsolete-face-alias 'eshell-test-ok-face 'eshell-test-ok "22.1")
|
29876
|
49
|
63533
|
50 (defface eshell-test-failed
|
29876
|
51 '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
|
|
52 (((class color) (background dark)) (:foreground "OrangeRed" :bold t))
|
|
53 (t (:bold t)))
|
|
54 "*The face used to highlight FAILED result strings."
|
|
55 :group 'eshell-test)
|
104783
|
56 (define-obsolete-face-alias 'eshell-test-failed-face 'eshell-test-failed "22.1")
|
29876
|
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
|
95619
|
72 (defvar test-buffer)
|
29876
|
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
|
108765
d835100c3e8b
Replace Lisp calls to delete-backward-char by delete-char.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
104 (delete-char -6)
|
29876
|
105 (insert-before-markers
|
|
106 "[" (let (str)
|
|
107 (if truth
|
|
108 (progn
|
|
109 (setq str " OK ")
|
63533
|
110 (put-text-property 0 6 'face 'eshell-test-ok str))
|
29876
|
111 (setq str "FAILED")
|
|
112 (setq eshell-test-failures (1+ eshell-test-failures))
|
63533
|
113 (put-text-property 0 6 'face 'eshell-test-failed str))
|
29876
|
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))
|
59120
|
125 (library (locate-library (symbol-file fsym 'defun)))
|
29876
|
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
|
55581
|
167 (insert "Testing Eshell under " (emacs-version))
|
29876
|
168 (switch-to-buffer test-buffer)
|
|
169 (delete-other-windows))
|
33020
|
170 (eshell-for funcname (sort (all-completions "eshell-test--"
|
|
171 obarray 'functionp)
|
|
172 'string-lessp)
|
29876
|
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
|
|
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
|
|
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
|
87088
|
233 (provide 'esh-test)
|
|
234
|
93975
|
235 ;; arch-tag: 6e32275a-8285-4a4e-b7cf-819aa7c86b8e
|
29876
|
236 ;;; esh-test.el ends here
|