diff options
Diffstat (limited to 'test/lisp/term-tests.el')
| -rw-r--r-- | test/lisp/term-tests.el | 406 |
1 files changed, 406 insertions, 0 deletions
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el new file mode 100644 index 00000000000..f60d2ff5747 --- /dev/null +++ b/test/lisp/term-tests.el @@ -0,0 +1,406 @@ +;;; term-tests.el --- tests for term.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017, 2019-2022 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. + +(defvar yellow-fg-props + `( :foreground ,(face-foreground 'term-color-yellow nil 'default) + :background "unspecified-bg" :inverse-video nil)) +(defvar yellow-bg-props + `( :foreground "unspecified-fg" + :background ,(face-background 'term-color-yellow nil 'default) + :inverse-video nil)) +(defvar bright-yellow-fg-props + `( :foreground ,(face-foreground 'term-color-bright-yellow nil 'default) + :background "unspecified-bg" :inverse-video nil)) +(defvar bright-yellow-bg-props + `( :foreground "unspecified-fg" + :background ,(face-background 'term-color-bright-yellow nil 'default) + :inverse-video nil)) +(defvar custom-color-fg-props + `( :foreground "#87FFFF" + :background "unspecified-bg" :inverse-video nil)) + +(defvar ansi-test-strings + `(("\e[33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face `(,yellow-fg-props))) + ("\e[43mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face `(,yellow-bg-props))) + ("\e[93mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face `(,bright-yellow-fg-props))) + ("\e[103mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face `(,bright-yellow-bg-props))) + ("\e[1;33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[33;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[1m\e[33mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[33m\e[1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[38;5;3;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,yellow-fg-props term-bold)) + ,(propertize "Hello World" 'font-lock-face + `(,bright-yellow-fg-props term-bold))) + ("\e[38;5;123;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,custom-color-fg-props term-bold))) + ("\e[38;2;135;255;255;1mHello World\e[0m" + ,(propertize "Hello World" 'font-lock-face + `(,custom-color-fg-props term-bold))))) + +(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)))) + ;; Don't get stuck when we close the buffer. + (set-process-query-on-exit-flag proc nil) + (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 (point-min) (point-max)))))) + +(ert-deftest term-simple-lines () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (let ((str "\ +first line\r +next line\r\n")) + (should (equal (term-test-screen-from-input 40 12 str) + (string-replace "\r" "" str))))) + +(ert-deftest term-carriage-return () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (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 () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (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-colors () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (pcase-dolist (`(,str ,expected) ansi-test-strings) + (let ((result (term-test-screen-from-input 40 12 str))) + (should (equal result expected)) + (should (equal (text-properties-at 0 result) + (text-properties-at 0 expected)))))) + +(ert-deftest term-colors-bold-is-bright () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (let ((ansi-color-bold-is-bright t)) + (pcase-dolist (`(,str ,expected ,bright-expected) ansi-test-strings) + (let ((expected (or bright-expected expected)) + (result (term-test-screen-from-input 40 12 str))) + (should (equal result expected)) + (should (equal (text-properties-at 0 result) + (text-properties-at 0 expected))))))) + +(ert-deftest term-cursor-movement () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + ;; 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)))) + (should (equal "abcde j" + (term-test-screen-from-input + 10 12 '("abcdefghij" + "\e[H" ;move back to point-min + "abcde" + " j")))) + + ;; 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 () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (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 +"))) + + ;; test reverse scrolling + (should (equal "line1 +line7 +line6 +line2 +line5" + (term-test-screen-from-input 40 5 + '("\e[0;0H" + "\e[J" + "line1\r +line2\r +line3\r +line4\r +line5" + "\e[2;4r" + "\e[2;0H" + "\e[2;0H" + "\eMline6" + "\e[2;0H" + "\eMline7")))) + + ;; test scrolling down + (should (equal "line1 +line3 +line4 +line7 +line5" + (term-test-screen-from-input 40 5 + '("\e[0;0H" + "\e[J" + "line1\r +line2\r +line3\r +line4\r +line5" + "\e[2;4r" + "\e[2;0H" + "\e[4;5H" + "\n\rline7")))) + + ;; setting the scroll region end beyond the max height should not + ;; turn on term-scroll-with-delete + (should (equal "line1 +line2 +line3 +line4 +line5 +line6 +line7" + (term-test-screen-from-input 40 5 + '("\e[1;10r" + "line1\r +line2\r +line3\r +line4\r +line5\r +line6\r +line7")))) + + + ;; resetting the terminal should set the scroll region end to (1- term-height). + (should (equal " +line1 +line2 +line3 +line4 +" + (term-test-screen-from-input 40 5 + '("\e[1;10r" + "\ec" ;reset + "line1\r +line2\r +line3\r +line4\r +line5" + "\e[1;1H" + "\e[L")))) + + ;; scroll region should be limited to the (1- term-height). Note, + ;; this fixes an off by one error when comparing the scroll region + ;; end with term-height. + (should (equal " +line1 +line2 +line3 +line4 +" + (term-test-screen-from-input 40 5 + '("\e[1;6r" + "line1\r +line2\r +line3\r +line4\r +line5" + "\e[1;1H" ;go back to home + "\e[L" ;insert a new line at the top + )))) + + ;; setting the scroll region to the entire height should not turn on + ;; term-scroll-with-delete + (should (equal "line1 +line2 +line3 +line4 +line5 +line6" + (term-test-screen-from-input 40 5 + '("\e[1;5r" + "line1\r +line2\r +line3\r +line4\r +line5\r +line6")))) + + ;; reset should reset term-scroll-with-delete + (should (equal "line1 +line2 +line3 +line4 +line5 +line6 +line7" + (term-test-screen-from-input 40 5 + '("\e[2;5r" ;set the region + "\ec" ;reset + "line1\r +line2\r +line3\r +line4\r +line5\r +line6\r +line7"))))) + +(ert-deftest term-set-directory () + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (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/")))) + +(ert-deftest term-line-wrapping-then-motion () + "Make sure we reset the line-wrapping state after moving cursor. +A real-life example is the default zsh prompt which writes spaces +to the end of line (triggering line-wrapping state), and then +sends a carriage return followed by another space to overwrite +the first character of the line." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (let* ((width 10) + (strs (list "x" (make-string (1- width) ?_) + "\r_"))) + (should (equal (term-test-screen-from-input width 12 strs) + (make-string width ?_))))) + +(ert-deftest term-to-margin () + "Test cursor movement at the scroll margin. +This is a reduced example from GNU nano's initial screen." + (skip-unless (not (memq system-type '(windows-nt ms-dos)))) + (let* ((width 10) + (x (make-string width ?x)) + (y (make-string width ?y))) + (should (equal (term-test-screen-from-input + width 3 + `("\e[1;3r" ; Setup 3 line scrolling region. + "\e[2;1H" ; Move to 2nd last line. + ,x ; Fill with 'x'. + "\r\e[1B" ; Next line. + ,y)) ; Fill with 'y'. + (concat "\n" x "\n" y))) + ;; Same idea, but moving upwards. + (should (equal (term-test-screen-from-input + width 3 + `("\e[1;3r" "\e[2;1H" ,x "\r\e[1A" ,y)) + (concat y "\n" x))))) + +(ert-deftest term-decode-partial () ;; Bug#25288. + "Test multibyte characters sent into multiple chunks." + ;; Set `locale-coding-system' so test will be deterministic. + (let* ((locale-coding-system 'utf-8-unix) + (string (make-string 7 ?ш)) + (bytes (encode-coding-string string locale-coding-system))) + (should (equal string + (term-test-screen-from-input + 40 1 `(,(substring bytes 0 (/ (length bytes) 2)) + ,(substring bytes (/ (length bytes) 2)))))))) +(ert-deftest term-undecodable-input () ;; Bug#29918. + "Undecodable bytes should be passed through without error." + (let* ((locale-coding-system 'utf-8-unix) ; As above. + (bytes "\376\340\360\370") + (string (decode-coding-string bytes locale-coding-system))) + (should (equal string + (term-test-screen-from-input + 40 1 bytes))))) + +(provide 'term-tests) + +;;; term-tests.el ends here |