1 ;;; esh-test.el --- Eshell test suite
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: John Wiegley <johnw@gnu.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; The purpose of this module is to verify that Eshell works as
26 ;; expected. To run it on your system, use the command
36 (defgroup eshell-test nil
37 "This module is meant to ensure that Eshell is working correctly."
38 :tag
"Eshell test suite"
43 (defface eshell-test-ok
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."
48 ;; backward-compatibility alias
49 (put 'eshell-test-ok-face
'face-alias
'eshell-test-ok
)
51 (defface eshell-test-failed
52 '((((class color
) (background light
)) (:foreground
"OrangeRed" :bold t
))
53 (((class color
) (background dark
)) (:foreground
"OrangeRed" :bold t
))
55 "*The face used to highlight FAILED result strings."
57 ;; backward-compatibility alias
58 (put 'eshell-test-failed-face
'face-alias
'eshell-test-failed
)
60 (defcustom eshell-show-usage-metrics nil
61 "*If non-nil, display different usage metrics for each Eshell command."
62 :set
(lambda (symbol value
)
64 (add-hook 'eshell-mode-hook
'eshell-show-usage-metrics
)
65 (remove-hook 'eshell-mode-hook
'eshell-show-usage-metrics
))
67 :type
'(choice (const :tag
"No metrics" nil
)
68 (const :tag
"Cons cells consumed" t
)
69 (const :tag
"Time elapsed" 0))
76 (defun eshell-insert-command (text &optional func
)
77 "Insert a command at the end of the buffer."
78 (goto-char eshell-last-output-end
)
79 (insert-and-inherit text
)
80 (funcall (or func
'eshell-send-input
)))
82 (defun eshell-match-result (regexp)
83 "Insert a command at the end of the buffer."
84 (goto-char eshell-last-input-end
)
87 (defun eshell-command-result-p (text regexp
&optional func
)
88 "Insert a command at the end of the buffer."
89 (eshell-insert-command text func
)
90 (eshell-match-result regexp
))
92 (defvar eshell-test-failures nil
)
94 (defun eshell-run-test (module funcsym label command
)
95 "Test whether FORM evaluates to a non-nil value."
96 (when (let ((sym (intern-soft (concat "eshell-" (symbol-name module
)))))
97 (or (memq sym
(eshell-subgroups 'eshell
))
98 (eshell-using-module sym
)))
99 (with-current-buffer test-buffer
100 (insert-before-markers
101 (format "%-70s " (substring label
0 (min 70 (length label
)))))
102 (insert-before-markers " ....")
104 (let ((truth (eval command
)))
105 (with-current-buffer test-buffer
106 (delete-backward-char 6)
107 (insert-before-markers
112 (put-text-property 0 6 'face
'eshell-test-ok str
))
114 (setq eshell-test-failures
(1+ eshell-test-failures
))
115 (put-text-property 0 6 'face
'eshell-test-failed str
))
117 (add-text-properties (line-beginning-position) (point)
118 (list 'test-func funcsym
))
119 (eshell-redisplay)))))
121 (defun eshell-test-goto-func ()
122 "Jump to the function that defines a particular test."
124 (let ((fsym (get-text-property (point) 'test-func
)))
126 (let* ((def (symbol-function fsym
))
127 (library (locate-library (symbol-file fsym
'defun
)))
128 (name (substring (symbol-name fsym
)
129 (length "eshell-test--")))
130 (inhibit-redisplay t
))
132 (goto-char (point-min))
133 (re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
135 (beginning-of-line)))))
137 (defun eshell-run-one-test (&optional arg
)
138 "Jump to the function that defines a particular test."
140 (let ((fsym (get-text-property (point) 'test-func
)))
143 (delete-region (point) (line-end-position))
144 (let ((test-buffer (current-buffer)))
145 (set-buffer (let ((inhibit-redisplay t
))
146 (save-window-excursion (eshell t
))))
149 (kill-buffer (current-buffer)))))))
152 (defun eshell-test (&optional arg
)
153 "Test Eshell to verify that it works as expected."
155 (let* ((begin (eshell-time-to-seconds (current-time)))
156 (test-buffer (get-buffer-create "*eshell test*")))
157 (set-buffer (let ((inhibit-redisplay t
))
158 (save-window-excursion (eshell t
))))
159 (with-current-buffer test-buffer
161 (setq major-mode
'eshell-test-mode
)
162 (setq mode-name
"EShell Test")
163 (set (make-local-variable 'eshell-test-failures
) 0)
164 (local-set-key [(control ?c
) (control ?c
)] 'eshell-test-goto-func
)
165 (local-set-key [(control ?c
) (control ?r
)] 'eshell-run-one-test
)
166 (local-set-key [(control ?m
)] 'eshell-test-goto-func
)
167 (local-set-key [return] 'eshell-test-goto-func)
169 (insert "Testing Eshell under " (emacs-version))
170 (switch-to-buffer test-buffer)
171 (delete-other-windows))
172 (eshell-for funcname (sort (all-completions "eshell-test--"
175 (with-current-buffer test-buffer
177 (funcall (intern-soft funcname)))
178 (with-current-buffer test-buffer
179 (insert (format "\n\n--- %s --- (completed in %d seconds)\n"
180 (current-time-string)
181 (- (eshell-time-to-seconds (current-time))
183 (message "Eshell test suite completed: %s failure%s"
184 (if (> eshell-test-failures 0)
185 (number-to-string eshell-test-failures)
187 (if (= eshell-test-failures 1) "" "s"))))
188 (goto-char eshell-last-output-end)
190 (kill-buffer (current-buffer))))
193 (defvar eshell-metric-before-command 0)
194 (defvar eshell-metric-after-command 0)
196 (defun eshell-show-usage-metrics ()
197 "If run at Eshell mode startup, metrics are shown after each command."
198 (set (make-local-variable 'eshell-metric-before-command)
199 (if (eq eshell-show-usage-metrics t)
202 (set (make-local-variable 'eshell-metric-after-command)
203 (if (eq eshell-show-usage-metrics t)
207 (add-hook 'eshell-pre-command-hook
210 (setq eshell-metric-before-command
211 (if (eq eshell-show-usage-metrics t)
212 (car (memory-use-counts))
213 (current-time))))) nil t)
215 (add-hook 'eshell-post-command-hook
218 (setq eshell-metric-after-command
219 (if (eq eshell-show-usage-metrics t)
220 (car (memory-use-counts))
222 (eshell-interactive-print
225 (if (eq eshell-show-usage-metrics t)
226 (- eshell-metric-after-command
227 eshell-metric-before-command 7)
228 (- (eshell-time-to-seconds
229 eshell-metric-after-command)
230 (eshell-time-to-seconds
231 eshell-metric-before-command))))
237 ;; arch-tag: 6e32275a-8285-4a4e-b7cf-819aa7c86b8e
238 ;;; esh-test.el ends here