test/lisp/term-tests.el

   1 ;;; term-tests.el --- tests for term.el  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 \f
  23 ;;; Code:
  24 (require 'ert)
  25 (require 'term)
  26 (eval-when-compile (require 'cl-lib))
  27
  28 (defvar term-height)                    ; Number of lines in window.
  29 (defvar term-width)                     ; Number of columns in window.
  30
  31 (defun term-test-screen-from-input (width height input &optional return-var)
  32   (with-temp-buffer
  33     (term-mode)
  34     ;; Keep dimensions independent from window size.
  35     (remove-function (local 'window-adjust-process-window-size-function)
  36                      'term-maybe-reset-size)
  37     (term-exec (current-buffer) "test" "cat" nil nil)
  38     (term-char-mode)
  39     (setq term-width width)
  40     (setq term-height height)
  41     ;; Pass input directly to `term-emulate-terminal', it's easier to
  42     ;; control chunking, and we don't have to worry about wrestling
  43     ;; with stty settings.
  44     (let ((proc (get-buffer-process (current-buffer))))
  45       ;; Don't get stuck when we close the buffer.
  46       (set-process-query-on-exit-flag proc nil)
  47       (if (consp input)
  48                 (mapc (lambda (input) (term-emulate-terminal proc input)) input)
  49               (term-emulate-terminal proc input))
  50       (if return-var (buffer-local-value return-var (current-buffer))
  51         (buffer-substring-no-properties (point-min) (point-max))))))
  52
  53 (ert-deftest term-simple-lines ()
  54   (let ((str "\
  55 first line\r
  56 next line\r\n"))
  57     (should (equal (term-test-screen-from-input 40 12 str)
  58                    (replace-regexp-in-string "\r" "" str)))))
  59
  60 (ert-deftest term-carriage-return ()
  61   (let ((str "\
  62 first line\r_next line\r\n"))
  63     (should (equal (term-test-screen-from-input 40 12 str)
  64                    "_next line\n"))))
  65
  66 (ert-deftest term-line-wrap ()
  67   (should (string-match-p
  68            ;; Don't be strict about trailing whitespace.
  69            "\\`a\\{40\\}\na\\{20\\} *\\'"
  70            (term-test-screen-from-input 40 12 (make-string 60 ?a))))
  71   ;; Again, but split input into chunks.
  72   (should (string-match-p
  73            "\\`a\\{40\\}\na\\{20\\} *\\'"
  74            (term-test-screen-from-input 40 12 (let ((str (make-string 30 ?a)))
  75                                                 (list str str))))))
  76
  77 (ert-deftest term-cursor-movement ()
  78   ;; Absolute positioning.
  79   (should (equal "ab\ncd"
  80                  (term-test-screen-from-input
  81                   40 12 (concat "\e[2;2Hd"
  82                                 "\e[2;1Hc"
  83                                 "\e[1;2Hb"
  84                                 "\e[1;1Ha"))))
  85   ;; Send one byte at a time.
  86   (should (equal "ab\ncd"
  87                  (term-test-screen-from-input
  88                   40 12 (split-string (concat "\e[2;2Hd"
  89                                               "\e[2;1Hc"
  90                                               "\e[1;2Hb"
  91                                               "\e[1;1Ha") "" t))))
  92   (should (equal "abcde    j"
  93                  (term-test-screen-from-input
  94                   10 12 '("abcdefghij"
  95                           "\e[H"  ;move back to point-min
  96                           "abcde"
  97                           "    j"))))
  98
  99   ;; Relative positioning.
 100   (should (equal "ab\ncd"
 101                  (term-test-screen-from-input
 102                   40 12 (concat "\e[B\e[Cd"
 103                                 "\e[D\e[Dc"
 104                                 "\e[Ab"
 105                                 "\e[D\e[Da")))))
 106
 107 (ert-deftest term-scrolling-region ()
 108   (should (equal "\
 109 line3
 110 line4
 111 line5
 112 line6
 113 "
 114                  (term-test-screen-from-input
 115                   40 12 "\e[1;5r\
 116 line1\r
 117 line2\r
 118 line3\r
 119 line4\r
 120 line5\r
 121 line6\r
 122 "))))
 123
 124 (ert-deftest term-set-directory ()
 125   (let ((term-ansi-at-user (user-real-login-name)))
 126     (should (equal (term-test-screen-from-input
 127                     40 12 "\eAnSiTc /foo/\n" 'default-directory)
 128                    "/foo/"))
 129     ;; Split input (Bug#17231).
 130     (should (equal (term-test-screen-from-input
 131                     40 12 (list "\eAnSiTc /f" "oo/\n") 'default-directory)
 132                    "/foo/"))))
 133
 134 (ert-deftest term-line-wrapping-then-motion ()
 135   "Make sure we reset the line-wrapping state after moving cursor.
 136 A real-life example is the default zsh prompt which writes spaces
 137 to the end of line (triggering line-wrapping state), and then
 138 sends a carriage return followed by another space to overwrite
 139 the first character of the line."
 140   (let* ((width 10)
 141          (strs (list "x" (make-string (1- width) ?_)
 142                      "\r_")))
 143     (should (equal (term-test-screen-from-input width 12 strs)
 144                    (make-string width ?_)))))
 145
 146 (ert-deftest term-to-margin ()
 147   "Test cursor movement at the scroll margin.
 148 This is a reduced example from GNU nano's initial screen."
 149   (let* ((width 10)
 150          (x (make-string width ?x))
 151          (y (make-string width ?y)))
 152     (should (equal (term-test-screen-from-input
 153                     width 3
 154                     `("\e[1;3r"       ; Setup 3 line scrolling region.
 155                       "\e[2;1H"       ; Move to 2nd last line.
 156                       ,x              ; Fill with 'x'.
 157                       "\r\e[1B"       ; Next line.
 158                       ,y))            ; Fill with 'y'.
 159                    (concat "\n" x "\n" y)))
 160     ;; Same idea, but moving upwards.
 161     (should (equal (term-test-screen-from-input
 162                     width 3
 163                     `("\e[1;3r" "\e[2;1H" ,x "\r\e[1A" ,y))
 164                    (concat y "\n" x)))))
 165
 166 (provide 'term-tests)
 167
 168 ;;; term-tests.el ends here