code.delx.au - gnu-emacs/blob - lisp/eshell/esh-test.el

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