Merge from trunk

3 files changed, 449 insertions, 14 deletions

diff --git a/test/ChangeLog b/test/ChangeLog
index dbfc6c6cefe..b247b88bc94 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,12 @@
+2011-03-05  Glenn Morris  <rgm@gnu.org>
+
+        * eshell.el: Move here from lisp/eshell/esh-test.el.
+
+2011-03-03  Christian Ohler  <ohler@gnu.org>
+
+        * automated/ert-tests.el (ert-test-explain-not-equal-keymaps):
+        New test.
+
 2011-02-20  Ulf Jasper  <ulf.jasper@web.de>
 
         * automated/icalendar-tests.el: Move from icalendar-testsuite.el;
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el
index b6d70dee7e2..cea994f64b8 100644
--- a/test/automated/ert-tests.el
+++ b/test/automated/ert-tests.el
@@ -796,27 +796,32 @@ This macro is used to test if macroexpansion in `should' works."
   (should (equal (ert--string-first-line "foo\nbar") "foo"))
   (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo")))
 
-(ert-deftest ert-test-explain-not-equal ()
-  (should (equal (ert--explain-not-equal nil 'foo)
+(ert-deftest ert-test-explain-equal ()
+  (should (equal (ert--explain-equal nil 'foo)
                  '(different-atoms nil foo)))
-  (should (equal (ert--explain-not-equal '(a a) '(a b))
+  (should (equal (ert--explain-equal '(a a) '(a b))
                  '(list-elt 1 (different-atoms a b))))
-  (should (equal (ert--explain-not-equal '(1 48) '(1 49))
+  (should (equal (ert--explain-equal '(1 48) '(1 49))
                  '(list-elt 1 (different-atoms (48 "#x30" "?0")
                                                (49 "#x31" "?1")))))
-  (should (equal (ert--explain-not-equal 'nil '(a))
+  (should (equal (ert--explain-equal 'nil '(a))
                  '(different-types nil (a))))
-  (should (equal (ert--explain-not-equal '(a b c) '(a b c d))
+  (should (equal (ert--explain-equal '(a b c) '(a b c d))
                  '(proper-lists-of-different-length 3 4 (a b c) (a b c d)
                                                     first-mismatch-at 3)))
   (let ((sym (make-symbol "a")))
-    (should (equal (ert--explain-not-equal 'a sym)
+    (should (equal (ert--explain-equal 'a sym)
                    `(different-symbols-with-the-same-name a ,sym)))))
 
-(ert-deftest ert-test-explain-not-equal-improper-list ()
-  (should (equal (ert--explain-not-equal '(a . b) '(a . c))
+(ert-deftest ert-test-explain-equal-improper-list ()
+  (should (equal (ert--explain-equal '(a . b) '(a . c))
                  '(cdr (different-atoms b c)))))
 
+(ert-deftest ert-test-explain-equal-keymaps ()
+  ;; This used to be very slow.
+  (should (equal (make-keymap) (make-keymap)))
+  (should (equal (make-sparse-keymap) (make-sparse-keymap))))
+
 (ert-deftest ert-test-significant-plist-keys ()
   (should (equal (ert--significant-plist-keys '()) '()))
   (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t))
@@ -852,21 +857,21 @@ This macro is used to test if macroexpansion in `should' works."
   (should (equal (ert--abbreviate-string "bar" 1 t) "r"))
   (should (equal (ert--abbreviate-string "bar" 0 t) "")))
 
-(ert-deftest ert-test-explain-not-equal-string-properties ()
+(ert-deftest ert-test-explain-equal-string-properties ()
   (should
-   (equal (ert--explain-not-equal-including-properties #("foo" 0 1 (a b))
-                                                       "foo")
+   (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
+                                                   "foo")
           '(char 0 "f"
                  (different-properties-for-key a (different-atoms b nil))
                  context-before ""
                  context-after "oo")))
-  (should (equal (ert--explain-not-equal-including-properties
+  (should (equal (ert--explain-equal-including-properties
                   #("foo" 1 3 (a b))
                   #("goo" 0 1 (c d)))
                  '(array-elt 0 (different-atoms (?f "#x66" "?f")
                                                 (?g "#x67" "?g")))))
   (should
-   (equal (ert--explain-not-equal-including-properties
+   (equal (ert--explain-equal-including-properties
            #("foo" 0 1 (a b c d) 1 3 (a b))
            #("foo" 0 1 (c d a b) 1 2 (a foo)))
           '(char 1 "o" (different-properties-for-key a (different-atoms b foo))
diff --git a/test/eshell.el b/test/eshell.el
new file mode 100644
index 00000000000..3b392e84c24
--- /dev/null
+++ b/test/eshell.el
@@ -0,0 +1,421 @@
+;;; esh-test.el --- Eshell test suite
+
+;; Copyright (C) 1999-2011  Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; 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
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; 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:
+
+(eval-when-compile
+  (require 'cl)                         ; assert
+  (require 'eshell)
+  (require 'esh-util))
+(require 'esh-mode)
+
+(defgroup eshell-test nil
+  "This module is meant to ensure that Eshell is working correctly."
+  :tag "Eshell test suite"
+  :group 'eshell)
+
+;;; User Variables:
+
+(defface eshell-test-ok
+  '((((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)
+(define-obsolete-face-alias 'eshell-test-ok-face 'eshell-test-ok "22.1")
+
+(defface eshell-test-failed
+  '((((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)
+(define-obsolete-face-alias 'eshell-test-failed-face 'eshell-test-failed "22.1")
+
+(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:
+
+(defvar test-buffer)
+
+(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
+        (delete-char -6)
+        (insert-before-markers
+         "[" (let (str)
+               (if truth
+                   (progn
+                     (setq str "  OK  ")
+                     (put-text-property 0 6 'face 'eshell-test-ok str))
+                 (setq str "FAILED")
+                 (setq eshell-test-failures (1+ eshell-test-failures))
+                 (put-text-property 0 6 'face 'eshell-test-failed str))
+               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))
+             (library (locate-library (symbol-file fsym 'defun)))
+             (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 (float-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)
+
+      (insert "Testing Eshell under " (emacs-version))
+      (switch-to-buffer test-buffer)
+      (delete-other-windows))
+    (dolist (funcname (sort (all-completions "eshell-test--"
+                                                obarray 'functionp)
+                               'string-lessp))
+      (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)
+                      (- (float-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)
+                    (- (float-time
+                        eshell-metric-after-command)
+                       (float-time
+                        eshell-metric-before-command))))
+                 "\n"))))
+            nil t))
+
+
+;;; The tests.
+
+(defmacro eshell-deftest (module name label &rest forms)
+  (declare (indent 2))
+  (if (and (fboundp 'cl-compiling-file) (cl-compiling-file))
+      nil
+    (let ((fsym (intern (concat "eshell-test--" (symbol-name name)))))
+      `(eval-when-compile
+         (ignore
+          (defun ,fsym () ,label
+            (eshell-run-test (quote ,module) (quote ,fsym) ,label
+                             (quote (progn ,@forms)))))))))
+
+
+(eshell-deftest mode same-window-buffer-names
+  "`eshell-buffer-name' is a member of `same-window-buffer-names'"
+  (member eshell-buffer-name same-window-buffer-names))
+
+(eshell-deftest mode eshell-directory-exists
+  "`eshell-directory-name' exists and is writable"
+  (file-writable-p eshell-directory-name))
+
+(eshell-deftest mode eshell-directory-modes
+  "`eshell-directory-name' has correct access protections"
+  (or (eshell-under-windows-p)
+      (= (file-modes eshell-directory-name)
+         eshell-private-directory-modes)))
+
+(eshell-deftest mode simple-command-result
+  "`eshell-command-result' works with a simple command."
+  (= (eshell-command-result "+ 1 2") 3))
+
+
+(require 'em-banner)
+
+(eshell-deftest banner banner-displayed
+  "Startup banner is displayed at point-min"
+  (assert eshell-banner-message)
+  (let ((msg (eval eshell-banner-message)))
+    (assert msg)
+    (goto-char (point-min))
+    (looking-at msg)))
+
+
+(require 'esh-cmd)
+
+(eshell-deftest var last-result-var
+  "\"last result\" variable"
+  (eshell-command-result-p "+ 1 2; + $$ 2" "3\n5\n"))
+
+(eshell-deftest var last-result-var2
+  "\"last result\" variable"
+  (eshell-command-result-p "+ 1 2; + $$ $$" "3\n6\n"))
+
+(eshell-deftest var last-arg-var
+  "\"last arg\" variable"
+  (eshell-command-result-p "+ 1 2; + $_ 4" "3\n6\n"))
+
+(eshell-deftest cmd lisp-command
+  "Evaluate Lisp command"
+  (eshell-command-result-p "(+ 1 2)" "3"))
+
+(eshell-deftest cmd lisp-command-args
+  "Evaluate Lisp command (ignore args)"
+  (eshell-command-result-p "(+ 1 2) 3" "3"))
+
+(eshell-deftest cmd subcommand
+  "Run subcommand"
+  (eshell-command-result-p "{+ 1 2}" "3\n"))
+
+(eshell-deftest cmd subcommand-args
+  "Run subcommand (ignore args)"
+  (eshell-command-result-p "{+ 1 2} 3" "3\n"))
+
+(eshell-deftest cmd subcommand-lisp
+  "Run subcommand + Lisp form"
+  (eshell-command-result-p "{(+ 1 2)}" "3\n"))
+
+(eshell-deftest cmd named-command
+  "Execute named command"
+  (eshell-command-result-p "+ 1 2" "3\n"))
+
+
+(require 'esh-mode)
+
+(eshell-deftest mode major-mode
+  "Major mode is correct"
+  (eq major-mode 'eshell-mode))
+
+(eshell-deftest mode eshell-mode-variable
+  "`eshell-mode' is true"
+  (eq eshell-mode t))
+
+(eshell-deftest var window-height
+  "LINES equals window height"
+  (let ((eshell-stringify-t t))
+    (eshell-command-result-p "= $LINES (window-height)" "t\n")))
+
+(eshell-deftest mode command-running-p
+  "Modeline shows no command running"
+  (or (featurep 'xemacs)
+      (not eshell-status-in-modeline)
+      (and (memq 'eshell-command-running-string mode-line-format)
+           (equal eshell-command-running-string "--"))))
+
+(eshell-deftest arg forward-arg
+  "Move across command arguments"
+  (eshell-insert-command "echo $(+ 1 (- 4 3)) \"alpha beta\" file" 'ignore)
+  (let ((here (point)) begin valid)
+    (eshell-bol)
+    (setq begin (point))
+    (eshell-forward-argument 4)
+    (setq valid (= here (point)))
+    (eshell-backward-argument 4)
+    (prog1
+        (and valid (= begin (point)))
+      (eshell-bol)
+      (delete-region (point) (point-max)))))
+
+(eshell-deftest mode queue-input
+  "Queue command input"
+  (eshell-insert-command "sleep 2")
+  (eshell-insert-command "echo alpha" 'eshell-queue-input)
+  (let ((count 10))
+    (while (and eshell-current-command
+                (> count 0))
+      (sit-for 1 0)
+      (setq count (1- count))))
+  (eshell-match-result "alpha\n"))
+
+; (eshell-deftest proc send-to-subprocess
+;   "Send input to a subprocess"
+;   ;; jww (1999-12-06): what about when bc is unavailable?
+;   (if (not (eshell-search-path "bc"))
+;       t
+;     (eshell-insert-command "bc")
+;     (eshell-insert-command "1 + 2")
+;     (sit-for 1 0)
+;     (forward-line -1)
+;     (prog1
+;       (looking-at "3\n")
+;       (eshell-insert-command "quit")
+;       (sit-for 1 0))))
+
+(eshell-deftest io flush-output
+  "Flush previous output"
+  (eshell-insert-command "echo alpha")
+  (eshell-kill-output)
+  (and (eshell-match-result (regexp-quote "*** output flushed ***\n"))
+       (forward-line)
+       (= (point) eshell-last-output-start)))
+
+(eshell-deftest mode run-old-command
+  "Re-run an old command"
+  (eshell-insert-command "echo alpha")
+  (goto-char eshell-last-input-start)
+  (string= (eshell-get-old-input) "echo alpha"))
+
+
+(require 'esh-var)
+
+(eshell-deftest var interp-cmd
+  "Interpolate command result"
+  (eshell-command-result-p "+ ${+ 1 2} 3" "6\n"))
+
+(eshell-deftest var interp-lisp
+  "Interpolate Lisp form evalution"
+  (eshell-command-result-p "+ $(+ 1 2) 3" "6\n"))
+
+(eshell-deftest var interp-concat
+  "Interpolate and concat command"
+  (eshell-command-result-p "+ ${+ 1 2}3 3" "36\n"))
+
+(eshell-deftest var interp-concat-lisp
+  "Interpolate and concat Lisp form"
+  (eshell-command-result-p "+ $(+ 1 2)3 3" "36\n"))
+
+(eshell-deftest var interp-concat2
+  "Interpolate and concat two commands"
+  (eshell-command-result-p "+ ${+ 1 2}${+ 1 2} 3" "36\n"))
+
+(eshell-deftest var interp-concat-lisp2
+  "Interpolate and concat two Lisp forms"
+  (eshell-command-result-p "+ $(+ 1 2)$(+ 1 2) 3" "36\n"))
+
+
+(provide 'esh-test)
+
+;;; esh-test.el ends here