esh-test.el 7.7 KB
Newer Older
1
;;; esh-test.el --- Eshell test suite
Gerd Moellmann's avatar
Gerd Moellmann committed
2

3
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2008, 2009, 2010  Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
5

Gerd Moellmann's avatar
Gerd Moellmann committed
6 7
;; Author: John Wiegley <johnw@gnu.org>

Gerd Moellmann's avatar
Gerd Moellmann committed
8 9
;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Gerd Moellmann's avatar
Gerd Moellmann committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Gerd Moellmann's avatar
Gerd Moellmann committed
14 15 16 17 18 19 20

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Gerd Moellmann's avatar
Gerd Moellmann committed
22 23 24 25 26 27 28 29 30

;;; Commentary:

;; The purpose of this module is to verify that Eshell works as
;; expected.  To run it on your system, use the command
;; \\[eshell-test].

;;; Code:

31 32 33
(eval-when-compile
  (require 'eshell)
  (require 'esh-util))
Gerd Moellmann's avatar
Gerd Moellmann committed
34 35
(require 'esh-mode)

36 37 38 39 40
(defgroup eshell-test nil
  "This module is meant to ensure that Eshell is working correctly."
  :tag "Eshell test suite"
  :group 'eshell)

Gerd Moellmann's avatar
Gerd Moellmann committed
41 42
;;; User Variables:

43
(defface eshell-test-ok
Gerd Moellmann's avatar
Gerd Moellmann committed
44 45 46 47
  '((((class color) (background light)) (:foreground "Green" :bold t))
    (((class color) (background dark)) (:foreground "Green" :bold t)))
  "*The face used to highlight OK result strings."
  :group 'eshell-test)
48
(define-obsolete-face-alias 'eshell-test-ok-face 'eshell-test-ok "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
49

50
(defface eshell-test-failed
Gerd Moellmann's avatar
Gerd Moellmann committed
51 52 53 54 55
  '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
    (((class color) (background dark)) (:foreground "OrangeRed" :bold t))
    (t (:bold t)))
  "*The face used to highlight FAILED result strings."
  :group 'eshell-test)
56
(define-obsolete-face-alias 'eshell-test-failed-face 'eshell-test-failed "22.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71

(defcustom eshell-show-usage-metrics nil
  "*If non-nil, display different usage metrics for each Eshell command."
  :set (lambda (symbol value)
	 (if value
	     (add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
	   (remove-hook 'eshell-mode-hook 'eshell-show-usage-metrics))
	 (set symbol value))
  :type '(choice (const :tag "No metrics" nil)
		 (const :tag "Cons cells consumed" t)
		 (const :tag "Time elapsed" 0))
  :group 'eshell-test)

;;; Code:

72
(defvar test-buffer)
Gerd Moellmann's avatar
Gerd Moellmann committed
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103

(defun eshell-insert-command (text &optional func)
  "Insert a command at the end of the buffer."
  (goto-char eshell-last-output-end)
  (insert-and-inherit text)
  (funcall (or func 'eshell-send-input)))

(defun eshell-match-result (regexp)
  "Insert a command at the end of the buffer."
  (goto-char eshell-last-input-end)
  (looking-at regexp))

(defun eshell-command-result-p (text regexp &optional func)
  "Insert a command at the end of the buffer."
  (eshell-insert-command text func)
  (eshell-match-result regexp))

(defvar eshell-test-failures nil)

(defun eshell-run-test (module funcsym label command)
  "Test whether FORM evaluates to a non-nil value."
  (when (let ((sym (intern-soft (concat "eshell-" (symbol-name module)))))
	  (or (memq sym (eshell-subgroups 'eshell))
	      (eshell-using-module sym)))
    (with-current-buffer test-buffer
      (insert-before-markers
       (format "%-70s " (substring label 0 (min 70 (length label)))))
      (insert-before-markers "  ....")
      (eshell-redisplay))
    (let ((truth (eval command)))
      (with-current-buffer test-buffer
104
	(delete-char -6)
Gerd Moellmann's avatar
Gerd Moellmann committed
105 106 107 108 109
	(insert-before-markers
	 "[" (let (str)
	       (if truth
		   (progn
		     (setq str "  OK  ")
110
		     (put-text-property 0 6 'face 'eshell-test-ok str))
Gerd Moellmann's avatar
Gerd Moellmann committed
111 112
		 (setq str "FAILED")
		 (setq eshell-test-failures (1+ eshell-test-failures))
113
		 (put-text-property 0 6 'face 'eshell-test-failed str))
Gerd Moellmann's avatar
Gerd Moellmann committed
114 115 116 117 118 119 120 121 122 123 124
	       str) "]")
	(add-text-properties (line-beginning-position) (point)
			     (list 'test-func funcsym))
	(eshell-redisplay)))))

(defun eshell-test-goto-func ()
  "Jump to the function that defines a particular test."
  (interactive)
  (let ((fsym (get-text-property (point) 'test-func)))
    (when fsym
      (let* ((def (symbol-function fsym))
125
	     (library (locate-library (symbol-file fsym 'defun)))
Gerd Moellmann's avatar
Gerd Moellmann committed
126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
	     (name (substring (symbol-name fsym)
			      (length "eshell-test--")))
	     (inhibit-redisplay t))
	(find-file library)
	(goto-char (point-min))
	(re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
				   name))
	(beginning-of-line)))))

(defun eshell-run-one-test (&optional arg)
  "Jump to the function that defines a particular test."
  (interactive "P")
  (let ((fsym (get-text-property (point) 'test-func)))
    (when fsym
      (beginning-of-line)
      (delete-region (point) (line-end-position))
      (let ((test-buffer (current-buffer)))
	(set-buffer (let ((inhibit-redisplay t))
		      (save-window-excursion (eshell t))))
	(funcall fsym)
	(unless arg
	  (kill-buffer (current-buffer)))))))

;;;###autoload
(defun eshell-test (&optional arg)
  "Test Eshell to verify that it works as expected."
  (interactive "P")
  (let* ((begin (eshell-time-to-seconds (current-time)))
	 (test-buffer (get-buffer-create "*eshell test*")))
    (set-buffer (let ((inhibit-redisplay t))
		  (save-window-excursion (eshell t))))
    (with-current-buffer test-buffer
      (erase-buffer)
      (setq major-mode 'eshell-test-mode)
      (setq mode-name "EShell Test")
      (set (make-local-variable 'eshell-test-failures) 0)
      (local-set-key [(control ?c) (control ?c)] 'eshell-test-goto-func)
      (local-set-key [(control ?c) (control ?r)] 'eshell-run-one-test)
      (local-set-key [(control ?m)] 'eshell-test-goto-func)
      (local-set-key [return] 'eshell-test-goto-func)

167
      (insert "Testing Eshell under " (emacs-version))
Gerd Moellmann's avatar
Gerd Moellmann committed
168 169
      (switch-to-buffer test-buffer)
      (delete-other-windows))
John Wiegley's avatar
John Wiegley committed
170 171 172
    (eshell-for funcname (sort (all-completions "eshell-test--"
						obarray 'functionp)
			       'string-lessp)
Gerd Moellmann's avatar
Gerd Moellmann committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
      (with-current-buffer test-buffer
	(insert "\n"))
      (funcall (intern-soft funcname)))
    (with-current-buffer test-buffer
      (insert (format "\n\n--- %s --- (completed in %d seconds)\n"
		      (current-time-string)
		      (- (eshell-time-to-seconds (current-time))
			 begin)))
      (message "Eshell test suite completed: %s failure%s"
	       (if (> eshell-test-failures 0)
		   (number-to-string eshell-test-failures)
		 "No")
	       (if (= eshell-test-failures 1) "" "s"))))
  (goto-char eshell-last-output-end)
  (unless arg
    (kill-buffer (current-buffer))))


(defvar eshell-metric-before-command 0)
(defvar eshell-metric-after-command 0)

(defun eshell-show-usage-metrics ()
  "If run at Eshell mode startup, metrics are shown after each command."
  (set (make-local-variable 'eshell-metric-before-command)
       (if (eq eshell-show-usage-metrics t)
	   0
	 (current-time)))
  (set (make-local-variable 'eshell-metric-after-command)
       (if (eq eshell-show-usage-metrics t)
	   0
	 (current-time)))

  (add-hook 'eshell-pre-command-hook
	    (function
	     (lambda ()
	       (setq eshell-metric-before-command
		     (if (eq eshell-show-usage-metrics t)
			 (car (memory-use-counts))
		       (current-time))))) nil t)

  (add-hook 'eshell-post-command-hook
	    (function
	     (lambda ()
	       (setq eshell-metric-after-command
		     (if (eq eshell-show-usage-metrics t)
			 (car (memory-use-counts))
		       (current-time)))
	       (eshell-interactive-print
		(concat
		 (int-to-string
		  (if (eq eshell-show-usage-metrics t)
		      (- eshell-metric-after-command
			 eshell-metric-before-command 7)
		    (- (eshell-time-to-seconds
			eshell-metric-after-command)
		       (eshell-time-to-seconds
			eshell-metric-before-command))))
		 "\n"))))
	    nil t))

233 234
(provide 'esh-test)

235
;; arch-tag: 6e32275a-8285-4a4e-b7cf-819aa7c86b8e
Gerd Moellmann's avatar
Gerd Moellmann committed
236
;;; esh-test.el ends here