Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 04:21:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Improve tramp-tests.el

Browse source 
* test/lisp/net/tramp-tests.el (ert-temp-file-prefix)
(ert-temp-file-suffix, ert--with-temp-file-generate-suffix)
(ert-with-temp-file, ert-with-temp-directory): Add them if they
don't exist.
(tramp--test-make-temp-name, tramp--test-kubernetes-p)
(tramp--test-supports-set-file-times-p): New defuns.
(tramp--test-make-temp-name): Use `tramp--test-make-temp-prefix'.
(tramp-test03-file-error, tramp-test20-file-modes)
(tramp-test22-file-times, tramp-test26-file-name-completion):
Adapt tests.
This commit is contained in:
Michael Albinus 2026-03-11 16:26:35 +01:00
parent adafe4f72b
commit d3adff8c8f
1 changed files with 117 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

145
test/lisp/net/tramp-tests.el
View file

@ -103,8 +103,9 @@
(defvar remote-file-name-access-timeout)
(defvar remote-file-name-inhibit-delete-by-moving-to-trash)
;; `ert-remote-temporary-file-directory' was introduced in Emacs 29.1.
;; Adapting `tramp-remote-path' happens also there.
;; `ert-remote-temporary-file-directory', `ert-with-temp-file' and
;; `ert-with-temp-directory' were introduced in Emacs 29.1. Adapting
;; `tramp-remote-path' happens also there.
(unless (boundp 'ert-remote-temporary-file-directory)
(eval-and-compile
;; There is no default value on w32 systems, which could work out
@ -130,7 +131,81 @@
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for remote file tests.")))
"Temporary directory for remote file tests.")
(defvar ert-temp-file-prefix "emacs-test-"
"Prefix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
(defvar ert-temp-file-suffix nil
"Suffix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
(defun ert--with-temp-file-generate-suffix (filename)
"Generate temp file suffix from FILENAME."
(thread-last
(file-name-base filename)
(replace-regexp-in-string (rx string-start
(group (+? not-newline))
(regexp "-?tests?")
string-end)
"\\1")
(concat "-")))
(defmacro ert-with-temp-file (name &rest body)
"Bind NAME to the name of a new temporary file and evaluate BODY."
(declare (indent 1) (debug (symbolp body)))
(cl-check-type name symbol)
(let (keyw prefix suffix directory text extra-keywords buffer coding)
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
(pcase keyw
(:prefix (setq prefix (pop body)))
(:suffix (setq suffix (pop body)))
;; This is only for internal use by `ert-with-temp-directory'
;; and is therefore not documented.
(:directory (setq directory (pop body)))
(:text (setq text (pop body)))
(:buffer (setq buffer (pop body)))
(:coding (setq coding (pop body)))
(_ (push keyw extra-keywords) (pop body))))
(when extra-keywords
(error
"Invalid keywords: %s" (mapconcat #'symbol-name extra-keywords " ")))
(let ((temp-file (make-symbol "temp-file"))
(prefix (or prefix ert-temp-file-prefix))
(suffix (or suffix ert-temp-file-suffix
(ert--with-temp-file-generate-suffix
(or (macroexp-file-name) buffer-file-name)))))
`(let* ((coding-system-for-write ,(or coding coding-system-for-write))
(,temp-file (,(if directory 'file-name-as-directory 'identity)
(make-temp-file
,prefix ,directory ,suffix ,text)))
(,name ,(if directory
`(file-name-as-directory ,temp-file)
temp-file))
,@(when buffer
(list `(,buffer (find-file-literally ,temp-file)))))
(unwind-protect
(progn ,@body)
(ignore-errors
,@(when buffer
(list `(with-current-buffer ,buffer
(set-buffer-modified-p nil))
`(kill-buffer ,buffer))))
(ignore-errors
,(if directory
`(delete-directory ,temp-file :recursive)
`(delete-file ,temp-file))))))))
(defmacro ert-with-temp-directory (name &rest body)
"Bind NAME to the name of a new temporary directory and evaluate BODY."
(declare (indent 1) (debug (symbolp body)))
(let ((tail body) keyw)
(while (keywordp (setq keyw (car tail)))
(setq tail (cddr tail))
(pcase keyw (:text (error "Invalid keyword for directory: :text")))))
`(ert-with-temp-file ,name
:directory t
,@body))))
;; Beautify batch mode.
(when noninteractive
@ -167,16 +242,22 @@
(defconst tramp-test-name-prefix "tramp-test"
"Prefix to use for temporary test files.")
(defun tramp--test-make-temp-prefix (&optional local quoted)
"Return a temporary file name prefix for test.
If LOCAL is non-nil, a local file name is returned.
If QUOTED is non-nil, the local part of the file name is quoted."
(funcall
(if quoted #'file-name-quote #'identity)
(expand-file-name
tramp-test-name-prefix
(if local temporary-file-directory ert-remote-temporary-file-directory))))
(defun tramp--test-make-temp-name (&optional local quoted)
"Return a temporary file name for test.
If LOCAL is non-nil, a local file name is returned.
If QUOTED is non-nil, the local part of the file name is quoted.
The temporary file is not created."
(funcall
(if quoted #'file-name-quote #'identity)
(expand-file-name
(make-temp-name tramp-test-name-prefix)
(if local temporary-file-directory ert-remote-temporary-file-directory))))
(make-temp-name (tramp--test-make-temp-prefix local quoted)))
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
@ -2224,11 +2305,14 @@ being the result.")
;; `ftp-error' and `remote-file-error' are subcategories of
;; `file-error'. Let's check this as well.
:type '(user-error file-error))
;; Check multi-hop.
(should-error
(file-exists-p
(tramp-file-name-with-sudo (tramp-make-tramp-file-name vec)))
:type '(user-error file-error)))))
;; Check multi-hop. `tramp-file-name-with-sudo' does not work
;; for the "kubernetes" method due to connection-local
;; `tramp-extra-expand-args'.
(unless (tramp--test-kubernetes-p)
(should-error
(file-exists-p
(tramp-file-name-with-sudo (tramp-make-tramp-file-name vec)))
:type '(user-error file-error))))))
(ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'."
@ -4208,6 +4292,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(unwind-protect
(progn
;; Setting the mode for not existing files shall fail.
(should-error
(set-file-modes tmp-name1 #o000)
:type 'file-missing)
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(set-file-modes tmp-name1 #o777)
@ -4585,10 +4673,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
(skip-unless (tramp--test-enabled))
(skip-unless
(or (tramp--test-adb-p) (tramp--test-gvfs-p)
(tramp--test-sh-p) (tramp--test-smb-p)
(tramp--test-sudoedit-p)))
(skip-unless (tramp--test-supports-set-file-times-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@ -4960,14 +5045,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tramp-fuse-remove-hidden-files t)
(tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(ert-with-temp-directory tmp-name
:prefix (tramp--test-make-temp-prefix nil quoted) :suffix ""
(let ((tramp-fuse-remove-hidden-files t))
;; Local files.
(make-directory tmp-name)
(should (file-directory-p tmp-name))
(write-region "foo" nil (expand-file-name "foo" tmp-name))
(should (file-exists-p (expand-file-name "foo" tmp-name)))
(write-region "bar" nil (expand-file-name "bold" tmp-name))
@ -5024,10 +5105,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should
(equal
(sort (file-name-all-completions "" tmp-name) #'string-lessp)
'("../" "./" "bold" "boz/" "foo" "foo.ext")))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive)))))))
'("../" "./" "bold" "boz/" "foo" "foo.ext")))))))))
(tramp--test-deftest-with-perl tramp-test26-file-name-completion)
@ -7532,6 +7610,11 @@ a $'' syntax."
"ksh"
(tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-kubernetes-p ()
"Check, whether the kubernetes method is used."
(string-equal
"kubernetes" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-macos-p ()
"Check, whether the remote host runs macOS."
;; We must refill the cache. `file-truename' does it.
@ -7668,6 +7751,12 @@ This requires restrictions of file name syntax."
(string-suffix-p
"ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))))
(defun tramp--test-supports-set-file-times-p ()
"Return whether the method under test supports setting file times."
(or (tramp--test-adb-p) (tramp--test-gvfs-p)
(tramp--test-sh-p) (tramp--test-smb-p)
(tramp--test-sudoedit-p)))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))