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