1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
emacs/test/lisp/eshell/eshell-tests-helpers.el
Po Lu ecf08f0621 Merge from savannah/emacs-29
dc4e6b1329 ; Update copyright years in more files
64b3777631 ; Run set-copyright from admin.el
8e1c56ae46 ; Add 2024 to copyright years

# Conflicts:
#	doc/misc/modus-themes.org
#	doc/misc/texinfo.tex
#	etc/NEWS
#	etc/refcards/ru-refcard.tex
#	etc/themes/modus-operandi-theme.el
#	etc/themes/modus-themes.el
#	etc/themes/modus-vivendi-theme.el
#	lib/alloca.in.h
#	lib/binary-io.h
#	lib/c-ctype.h
#	lib/c-strcasecmp.c
#	lib/c-strncasecmp.c
#	lib/careadlinkat.c
#	lib/cloexec.c
#	lib/close-stream.c
#	lib/diffseq.h
#	lib/dup2.c
#	lib/filemode.h
#	lib/fpending.c
#	lib/fpending.h
#	lib/fsusage.c
#	lib/getgroups.c
#	lib/getloadavg.c
#	lib/gettext.h
#	lib/gettime.c
#	lib/gettimeofday.c
#	lib/group-member.c
#	lib/malloc.c
#	lib/md5-stream.c
#	lib/md5.c
#	lib/md5.h
#	lib/memmem.c
#	lib/memrchr.c
#	lib/nanosleep.c
#	lib/save-cwd.h
#	lib/sha1.c
#	lib/sig2str.c
#	lib/stdlib.in.h
#	lib/strtoimax.c
#	lib/strtol.c
#	lib/strtoll.c
#	lib/time_r.c
#	lib/xalloc-oversized.h
#	lisp/auth-source-pass.el
#	lisp/emacs-lisp/lisp-mnt.el
#	lisp/emacs-lisp/timer.el
#	lisp/info-look.el
#	lisp/jit-lock.el
#	lisp/loadhist.el
#	lisp/mail/rmail.el
#	lisp/net/ntlm.el
#	lisp/net/webjump.el
#	lisp/progmodes/asm-mode.el
#	lisp/progmodes/project.el
#	lisp/progmodes/sh-script.el
#	lisp/textmodes/flyspell.el
#	lisp/textmodes/reftex-toc.el
#	lisp/textmodes/reftex.el
#	lisp/textmodes/tex-mode.el
#	lisp/url/url-gw.el
#	m4/alloca.m4
#	m4/clock_time.m4
#	m4/d-type.m4
#	m4/dirent_h.m4
#	m4/dup2.m4
#	m4/euidaccess.m4
#	m4/fchmodat.m4
#	m4/filemode.m4
#	m4/fsusage.m4
#	m4/getgroups.m4
#	m4/getloadavg.m4
#	m4/getrandom.m4
#	m4/gettime.m4
#	m4/gettimeofday.m4
#	m4/gnulib-common.m4
#	m4/group-member.m4
#	m4/inttypes.m4
#	m4/malloc.m4
#	m4/manywarnings.m4
#	m4/mempcpy.m4
#	m4/memrchr.m4
#	m4/mkostemp.m4
#	m4/mktime.m4
#	m4/nproc.m4
#	m4/nstrftime.m4
#	m4/pathmax.m4
#	m4/pipe2.m4
#	m4/pselect.m4
#	m4/pthread_sigmask.m4
#	m4/readlink.m4
#	m4/realloc.m4
#	m4/sig2str.m4
#	m4/ssize_t.m4
#	m4/stat-time.m4
#	m4/stddef_h.m4
#	m4/stdint.m4
#	m4/stdio_h.m4
#	m4/stdlib_h.m4
#	m4/stpcpy.m4
#	m4/strnlen.m4
#	m4/strtoimax.m4
#	m4/strtoll.m4
#	m4/time_h.m4
#	m4/timegm.m4
#	m4/timer_time.m4
#	m4/timespec.m4
#	m4/unistd_h.m4
#	m4/warnings.m4
#	nt/configure.bat
#	nt/preprep.c
#	test/lisp/register-tests.el
2024-01-02 10:28:14 +08:00

193 lines
7.1 KiB
EmacsLisp

;;; eshell-tests-helpers.el --- Eshell test suite helpers -*- lexical-binding:t -*-
;; Copyright (C) 1999-2024 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Eshell test suite helpers.
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'esh-mode)
(require 'eshell)
(defvar eshell-history-file-name nil)
(defvar eshell-last-dir-ring-file-name nil)
(defvar eshell-test--max-wait-time 5
"The maximum amount of time to wait for a condition to resolve, in seconds.
See `eshell-wait-for'.")
(defun eshell-tests-remote-accessible-p ()
"Return if a test involving remote files can proceed.
If using this function, be sure to load `tramp' near the
beginning of the test file."
(ignore-errors
(and
(file-remote-p ert-remote-temporary-file-directory)
(file-directory-p ert-remote-temporary-file-directory)
(file-writable-p ert-remote-temporary-file-directory))))
(defmacro with-temp-eshell (&rest body)
"Evaluate BODY in a temporary Eshell buffer."
`(save-current-buffer
(ert-with-temp-directory eshell-directory-name
(let* (;; We want no history file, so prevent Eshell from falling
;; back on $HISTFILE.
(process-environment (cons "HISTFILE" process-environment))
;; Enable process debug instrumentation. We may be able
;; to remove this eventually once we're confident that
;; all the process bugs have been worked out. (At that
;; point, we can just enable this selectively when
;; needed.) See also `eshell-test-command-result'
;; below.
(eshell-debug-command (cons 'process eshell-debug-command))
(eshell-history-file-name nil)
(eshell-last-dir-ring-file-name nil)
(eshell-buffer (eshell t)))
(unwind-protect
(with-current-buffer eshell-buffer
,@body)
(let (kill-buffer-query-functions)
(kill-buffer eshell-buffer)))))))
(defmacro eshell-with-temp-buffer (bufname text &rest body)
"Create a temporary buffer containing TEXT and evaluate BODY there.
BUFNAME will be set to the name of the temporary buffer."
(declare (indent 2))
`(with-temp-buffer
(insert ,text)
(rename-buffer "eshell-temp-buffer" t)
(let ((,bufname (buffer-name)))
,@body)))
(defun eshell-wait-for (predicate &optional message)
"Wait until PREDICATE returns non-nil.
If this takes longer than `eshell-test--max-wait-time', raise an
error. MESSAGE is an optional message to use if this times out."
(let ((start (current-time))
(message (or message "timed out waiting for condition")))
(while (not (funcall predicate))
(when (> (float-time (time-since start))
eshell-test--max-wait-time)
(error message))
(sit-for 0.1))))
(defun eshell-wait-for-subprocess (&optional all)
"Wait until there is no interactive subprocess running in Eshell.
If ALL is non-nil, wait until there are no Eshell subprocesses at
all running.
If this takes longer than `eshell-test--max-wait-time',
raise an error."
(eshell-wait-for
(lambda ()
(not (if all eshell-process-list (eshell-interactive-process-p))))))
(defun eshell-get-debug-logs ()
"Get debug command logs for displaying on test failures."
(when (get-buffer eshell-debug-command-buffer)
(let ((separator (make-string 40 ?-)))
(with-current-buffer eshell-debug-command-buffer
(string-replace "\f" separator (buffer-string))))))
(defun eshell-insert-command (command &optional func)
"Insert a COMMAND at the end of the buffer.
After inserting, call FUNC. If FUNC is nil, instead call
`eshell-send-input'."
(goto-char eshell-last-output-end)
(insert-and-inherit command)
(funcall (or func 'eshell-send-input)))
(defun eshell-last-input ()
"Return the input of the last Eshell command."
(buffer-substring-no-properties
eshell-last-input-start eshell-last-input-end))
(defun eshell-last-output ()
"Return the output of the last Eshell command."
(buffer-substring-no-properties
(eshell-beginning-of-output) (eshell-end-of-output)))
(defun eshell-match-output (regexp)
"Test whether the output of the last command matches REGEXP."
(string-match-p regexp (eshell-last-output)))
(defun eshell-match-output--explainer (regexp)
"Explain the result of `eshell-match-output'."
`(mismatched-output
(command ,(eshell-last-input))
(output ,(eshell-last-output))
(regexp ,regexp)))
(put 'eshell-match-output 'ert-explainer #'eshell-match-output--explainer)
(defun eshell-match-command-output (command regexp &optional func
ignore-errors)
"Insert a COMMAND at the end of the buffer and match the output with REGEXP.
FUNC is the function to call after inserting the text (see
`eshell-insert-command').
If IGNORE-ERRORS is non-nil, ignore any errors signaled when
inserting the command."
(ert-info (#'eshell-get-debug-logs :prefix "Command logs: ")
(let ((debug-on-error (and (not ignore-errors) debug-on-error)))
(eshell-insert-command command func))
(eshell-wait-for-subprocess)
(should (eshell-match-output regexp))))
(defvar eshell-history-file-name)
(defun eshell-test-command-result (command)
"Like `eshell-command-result', but not using HOME."
(ert-with-temp-directory eshell-directory-name
(let ((eshell-history-file-name nil)
;; Enable process debug instrumentation. See
;; `with-temp-eshell' above.
(eshell-debug-command (cons 'process eshell-debug-command)))
(eshell-command-result command))))
(defun eshell-command-result--equal (_command actual expected)
"Compare the ACTUAL result of a COMMAND with its EXPECTED value."
(equal actual expected))
(defun eshell-command-result--equal-explainer (command actual expected)
"Explain the result of `eshell-command-result--equal'."
`(nonequal-result
(command ,command)
(result ,actual)
(expected ,expected)))
(put 'eshell-command-result--equal 'ert-explainer
#'eshell-command-result--equal-explainer)
(defun eshell-command-result-equal (command result)
"Execute COMMAND non-interactively and compare it to RESULT."
(ert-info (#'eshell-get-debug-logs :prefix "Command logs: ")
(should (eshell-command-result--equal
command
(eshell-test-command-result command)
result))))
(provide 'eshell-tests-helpers)
;;; eshell-tests-helpers.el ends here