diff options
author | Noam Postavsky <npostavs@gmail.com> | 2018-01-06 19:28:09 -0500 |
---|---|---|
committer | Noam Postavsky <npostavs@gmail.com> | 2018-01-18 22:17:40 -0500 |
commit | 1d50c185f0c857bb1a85945314b522540071f796 (patch) | |
tree | 0917acf47b9dc8a9d53750b17dd596316c10d56d | |
parent | 5472568a3c2338856d25380012ee4398e024c806 (diff) | |
download | emacs-1d50c185f0c857bb1a85945314b522540071f796.tar.gz |
Add tests for term.el
* lisp/term.el (term-mode): Add `name' attribute to
window-adjust-process-window-size-function value, so that it can be
removed easily by tests.
* test/lisp/term-tests.el: New tests.
-rw-r--r-- | lisp/term.el | 3 | ||||
-rw-r--r-- | test/lisp/term-tests.el | 137 |
2 files changed, 139 insertions, 1 deletions
diff --git a/lisp/term.el b/lisp/term.el index e51b7669e14..0492763854c 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1145,7 +1145,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." (lambda (size) (when size (term-reset-size (cdr size) (car size))) - size)) + size) + '((name . term-maybe-reset-size))) (add-hook 'read-only-mode-hook #'term-line-mode-buffer-read-only-update nil t) diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el new file mode 100644 index 00000000000..16466ea3cd4 --- /dev/null +++ b/test/lisp/term-tests.el @@ -0,0 +1,137 @@ +;;; term-tests.el --- tests for term.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + + +;;; Code: +(require 'ert) +(require 'term) +(eval-when-compile (require 'cl-lib)) + +(defvar term-height) ; Number of lines in window. +(defvar term-width) ; Number of columns in window. + +(defun term-test-screen-from-input (width height input &optional return-var) + (with-temp-buffer + (term-mode) + ;; Keep dimensions independent from window size. + (remove-function (local 'window-adjust-process-window-size-function) + 'term-maybe-reset-size) + (term-exec (current-buffer) "test" "cat" nil nil) + (term-char-mode) + (setq term-width width) + (setq term-height height) + ;; Pass input directly to `term-emulate-terminal', it's easier to + ;; control chunking, and we don't have to worry about wrestling + ;; with stty settings. + (let ((proc (get-buffer-process (current-buffer)))) + (unwind-protect + (prog2 (if (consp input) + (mapc (lambda (input) (term-emulate-terminal proc input)) input) + (term-emulate-terminal proc input)) + (if return-var (buffer-local-value return-var (current-buffer)) + (buffer-substring-no-properties (point-min) (point-max))) + ;; End the process to avoid query on buffer kill. + (process-send-eof proc) + (accept-process-output proc)) + ;; Make extra sure we don't get stuck in case we hit some + ;; error before sending eof. + (when (process-live-p proc) + (kill-process proc) + ;; Let Emacs update process status. + (accept-process-output proc)))))) + +(ert-deftest term-simple-lines () + (let ((str "\ +first line\r +next line\r\n")) + (should (equal (term-test-screen-from-input 40 12 str) + (replace-regexp-in-string "\r" "" str))))) + +(ert-deftest term-carriage-return () + (let ((str "\ +first line\r_next line\r\n")) + (should (equal (term-test-screen-from-input 40 12 str) + "_next line\n")))) + +(ert-deftest term-line-wrap () + (should (string-match-p + ;; Don't be strict about trailing whitespace. + "\\`a\\{40\\}\na\\{20\\} *\\'" + (term-test-screen-from-input 40 12 (make-string 60 ?a)))) + ;; Again, but split input into chunks. + (should (string-match-p + "\\`a\\{40\\}\na\\{20\\} *\\'" + (term-test-screen-from-input 40 12 (let ((str (make-string 30 ?a))) + (list str str)))))) + +(ert-deftest term-cursor-movement () + ;; Absolute positioning. + (should (equal "ab\ncd" + (term-test-screen-from-input + 40 12 (concat "\e[2;2Hd" + "\e[2;1Hc" + "\e[1;2Hb" + "\e[1;1Ha")))) + ;; Send one byte at a time. + (should (equal "ab\ncd" + (term-test-screen-from-input + 40 12 (split-string (concat "\e[2;2Hd" + "\e[2;1Hc" + "\e[1;2Hb" + "\e[1;1Ha") "" t)))) + ;; Relative positioning. + (should (equal "ab\ncd" + (term-test-screen-from-input + 40 12 (concat "\e[B\e[Cd" + "\e[D\e[Dc" + "\e[Ab" + "\e[D\e[Da"))))) + +(ert-deftest term-scrolling-region () + (should (equal "\ +line3 +line4 +line5 +line6 +" + (term-test-screen-from-input + 40 12 "\e[1;5r\ +line1\r +line2\r +line3\r +line4\r +line5\r +line6\r +")))) + +(ert-deftest term-set-directory () + (let ((term-ansi-at-user (user-real-login-name))) + (should (equal (term-test-screen-from-input + 40 12 "\eAnSiTc /foo/\n" 'default-directory) + "/foo/")) + ;; Split input (Bug#17231). + (should (equal (term-test-screen-from-input + 40 12 (list "\eAnSiTc /f" "oo/\n") 'default-directory) + "/foo/")))) + +(provide 'term-tests) + +;;; term-tests.el ends here |