(require 'cl-lib)
(require 'dired)
(require 'dired-aux)
(require 'tramp)
(require 'ert-x)
(require 'seq) (require 'tar-mode)
(require 'trace)
(require 'vc)
(require 'vc-bzr)
(require 'vc-git)
(require 'vc-hg)
(declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-chmod-h "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
(declare-function tramp-list-tramp-buffers "tramp-cmds")
(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
(defvar tramp-display-escape-sequence-regexp)
(defvar tramp-fuse-remove-hidden-files)
(defvar tramp-fuse-unmount-on-cleanup)
(defvar tramp-inline-compress-start-size)
(defvar tramp-persistency-file-name)
(defvar tramp-remote-path)
(defvar tramp-remote-process-environment)
(declare-function with-connection-local-variables "files-x")
(defvar lock-file-name-transforms)
(defvar process-file-return-signal-string)
(defvar remote-file-name-inhibit-locks)
(defvar shell-command-dont-erase-buffer)
(defvar dired-copy-dereference)
(unless (macrop 'ert-resource-file)
(eval-and-compile
(defvar ert-resource-directory-format "%s-resources/"
"Format for `ert-resource-directory'.")
(defvar ert-resource-directory-trim-left-regexp ""
"Regexp for `string-trim' (left) used by `ert-resource-directory'.")
(defvar ert-resource-directory-trim-right-regexp
(rx (? "-test" (? "s")) ".el")
"Regexp for `string-trim' (right) used by `ert-resource-directory'.")
(defmacro ert-resource-directory ()
"Return absolute file name of the resource directory for this file.
The path to the resource directory is the \"resources\" directory
in the same directory as the test file.
If that directory doesn't exist, use the directory named like the
test file but formatted by `ert-resource-directory-format' and trimmed
using `string-trim' with arguments
`ert-resource-directory-trim-left-regexp' and
`ert-resource-directory-trim-right-regexp'. The default values mean
that if called from a test file named \"foo-tests.el\", return
the absolute file name for \"foo-resources\"."
`(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
(and load-in-progress load-file-name)
buffer-file-name))
(default-directory (file-name-directory testfile)))
(file-truename
(if (file-accessible-directory-p "resources/")
(expand-file-name "resources/")
(expand-file-name
(format
ert-resource-directory-format
(string-trim testfile
ert-resource-directory-trim-left-regexp
ert-resource-directory-trim-right-regexp)))))))
(defmacro ert-resource-file (file)
"Return file name of resource file named FILE.
A resource file is in the resource directory as per
`ert-resource-directory'."
`(expand-file-name ,file (ert-resource-directory)))))
(unless (boundp 'ert-remote-temporary-file-directory)
(eval-and-compile
(defconst ert-remote-temporary-file-directory
(cond
((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
((eq system-type 'windows-nt) null-device)
(t (add-to-list
'tramp-methods
`("mock"
(tramp-login-program ,tramp-default-remote-shell)
(tramp-login-args (("-i")))
(tramp-direct-async ("-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for remote file tests.")
(when (getenv "EMACS_HYDRA_CI")
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))))
(when noninteractive
(fset #'shell-command-sentinel #'ignore)
(fset #'tramp-action-yesno
(lambda (_proc vec)
(tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t))
(eval-after-load 'tramp-gvfs
'(fset 'tramp-gvfs-handler-askquestion
(lambda (_message _choices) '(t nil 0)))))
(defconst tramp-test-vec
(and (file-remote-p ert-remote-temporary-file-directory)
(tramp-dissect-file-name ert-remote-temporary-file-directory))
"The used `tramp-file-name' structure.")
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-allow-unsafe-temporary-files t
tramp-cache-read-persistent-data t tramp-copy-size-limit nil
tramp-error-show-message-timeout nil
tramp-persistency-file-name nil
tramp-verbose 0)
(defvar tramp--test-enabled-checked nil
"Cached result of `tramp--test-enabled'.
If the function did run, the value is a cons cell, the `cdr'
being the result.")
(defun tramp--test-enabled ()
"Whether remote file access is enabled."
(unless (consp tramp--test-enabled-checked)
(setq
tramp--test-enabled-checked
(cons
t (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))))))
(when (cdr tramp--test-enabled-checked)
(dolist (dir `(,temporary-file-directory
,ert-remote-temporary-file-directory))
(dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
(ignore-errors
(if (file-directory-p file)
(delete-directory file 'recursive)
(delete-file file)))))
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
(cdr tramp--test-enabled-checked))
(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 #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(make-temp-name "tramp-test")
(if local temporary-file-directory ert-remote-temporary-file-directory))))
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug (body)))
`(condition-case err
(progn ,@body)
(file-error
(unless (string-equal (error-message-string err)
"make-symbolic-link not supported")
(signal (car err) (cdr err))))))
(defvar tramp--test-instrument-test-case-p nil
"Whether `tramp--test-instrument-test-case' run.
This shall used dynamically bound only.")
(defmacro tramp--test-instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
Print the content of the Tramp connection and debug buffers, if
`tramp-verbose' is greater than 3. Print traces if `tramp-verbose'
is greater than 10.
`should-error' is not handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
`(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
(trace-buffer (tramp-trace-buffer-name tramp-test-vec))
(debug-ignored-errors
(append
'("^make-symbolic-link not supported$"
"^error with add-name-to-file")
debug-ignored-errors))
inhibit-message)
(unwind-protect
(let ((tramp--test-instrument-test-case-p t)) ,@body)
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
(untrace-all)
(dolist (buf (tramp-list-tramp-buffers))
(message ";; %s\n%s" buf (tramp-get-buffer-string buf))
(kill-buffer buf))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
"Emit a message into ERT *Messages*."
(tramp--test-instrument-test-case 0
(apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
(defsubst tramp--test-backtrace ()
"Dump a backtrace into ERT *Messages*."
(tramp--test-instrument-test-case 10
(tramp-backtrace tramp-test-vec)))
(defmacro tramp--test-print-duration (message &rest body)
"Run BODY and print a message with duration, prompted by MESSAGE."
(declare (indent 1) (debug (stringp body)))
`(let ((start (current-time)))
(unwind-protect
(progn ,@body)
(tramp--test-message
"%s %f sec" ,message (float-time (time-subtract nil start))))))
(defalias 'tramp--test-always
(if (fboundp 'always)
#'always
(lambda (&rest _arguments)
"Do nothing and return t.
This function accepts any number of ARGUMENTS, but ignores them.
Also see `ignore'."
t)))
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
(tramp--test-message
"Remote directory: `%s'" ert-remote-temporary-file-directory)
(should (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)))))
(ert-deftest tramp-test01-file-name-syntax ()
"Check remote file name syntax."
(let ((syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'default)
(should (tramp-tramp-file-p "/method::"))
(should (tramp-tramp-file-p "/method:host:"))
(should (tramp-tramp-file-p "/method:user@:"))
(should (tramp-tramp-file-p "/method:user@host:"))
(should (tramp-tramp-file-p "/method:user@email@host:"))
(should (tramp-tramp-file-p "/method:host#1234:"))
(should (tramp-tramp-file-p "/method:user@host#1234:"))
(should (tramp-tramp-file-p "/method:1.2.3.4:"))
(should (tramp-tramp-file-p "/method:user@1.2.3.4:"))
(should (tramp-tramp-file-p "/method:[::1]:"))
(should (tramp-tramp-file-p "/method:user@[::1]:"))
(should (tramp-tramp-file-p "/method:[::ffff:1.2.3.4]:"))
(should (tramp-tramp-file-p "/method:user@[::ffff:1.2.3.4]:"))
(should (tramp-tramp-file-p "/method:::"))
(should (tramp-tramp-file-p "/method::/:"))
(should (tramp-tramp-file-p "/method::/path/to/file"))
(should (tramp-tramp-file-p "/method::/:/path/to/file"))
(should (tramp-tramp-file-p "/method::file"))
(should (tramp-tramp-file-p "/method::/:file"))
(should (tramp-tramp-file-p "/method1:|method2::"))
(should
(tramp-tramp-file-p "/method1:host1|method2:host2:"))
(should
(tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:"))
(should
(tramp-tramp-file-p
"/method1:user1@host1|method2:user2@host2|method3:user3@host3:"))
(should-not (tramp-tramp-file-p nil))
(should-not (tramp-tramp-file-p 'symbol))
(should-not (tramp-tramp-file-p "/method::file\nname"))
(should-not (tramp-tramp-file-p "/method::file\rname"))
(should-not (tramp-tramp-file-p "/host:"))
(should-not (tramp-tramp-file-p "/user@host:"))
(should-not (tramp-tramp-file-p "/1.2.3.4:"))
(should-not (tramp-tramp-file-p "/[]:"))
(should-not (tramp-tramp-file-p "/[::1]:"))
(should-not (tramp-tramp-file-p "/[::ffff:1.2.3.4]:"))
(should-not (tramp-tramp-file-p "/host:/:"))
(should-not (tramp-tramp-file-p "/host1|host2:"))
(should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
(should-not (tramp-tramp-file-p "/::"))
(should-not (tramp-tramp-file-p "/:@:"))
(should-not (tramp-tramp-file-p "/:[]:"))
(let (tramp-mode)
(should-not (tramp-tramp-file-p "/method:user@host:")))
(let ((tramp-ignored-file-name-regexp "^/method:user@host:"))
(should-not (tramp-tramp-file-p "/method:user@host:")))
(let ((system-type 'windows-nt))
(should-not (tramp-tramp-file-p "/c:/path/to/file"))
(should-not (tramp-tramp-file-p "/c::/path/to/file"))
(should (tramp-tramp-file-p "/-::/path/to/file"))
(should (tramp-tramp-file-p "/mm::/path/to/file")))
(let ((system-type 'gnu/linux))
(should-not (tramp-tramp-file-p "/m::/path/to/file"))
(should (tramp-tramp-file-p "/-:h:/path/to/file"))
(should (tramp-tramp-file-p "/mm::/path/to/file"))))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test01-file-name-syntax-simplified ()
"Check simplified file name syntax."
:tags '(:expensive-test)
(let ((syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'simplified)
(should (tramp-tramp-file-p "/host:"))
(should (tramp-tramp-file-p "/user@:"))
(should (tramp-tramp-file-p "/user@host:"))
(should (tramp-tramp-file-p "/user@email@host:"))
(should (tramp-tramp-file-p "/host#1234:"))
(should (tramp-tramp-file-p "/user@host#1234:"))
(should (tramp-tramp-file-p "/1.2.3.4:"))
(should (tramp-tramp-file-p "/user@1.2.3.4:"))
(should (tramp-tramp-file-p "/[::1]:"))
(should (tramp-tramp-file-p "/user@[::1]:"))
(should (tramp-tramp-file-p "/[::ffff:1.2.3.4]:"))
(should (tramp-tramp-file-p "/user@[::ffff:1.2.3.4]:"))
(should (tramp-tramp-file-p "/host::"))
(should (tramp-tramp-file-p "/host:/:"))
(should (tramp-tramp-file-p "/host:/path/to/file"))
(should (tramp-tramp-file-p "/host:/:/path/to/file"))
(should (tramp-tramp-file-p "/host:file"))
(should (tramp-tramp-file-p "/host:/:file"))
(should (tramp-tramp-file-p "/host1|host2:"))
(should (tramp-tramp-file-p "/user1@host1|user2@host2:"))
(should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:"))
(should-not (tramp-tramp-file-p nil))
(should-not (tramp-tramp-file-p 'symbol))
(should-not (tramp-tramp-file-p "/::"))
(should-not (tramp-tramp-file-p "/:@:"))
(should-not (tramp-tramp-file-p "/:[]:")))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test01-file-name-syntax-separate ()
"Check separate file name syntax."
:tags '(:expensive-test)
(let ((syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'separate)
(should (tramp-tramp-file-p "/[method/]"))
(should (tramp-tramp-file-p "/[method/host]"))
(should (tramp-tramp-file-p "/[method/user@]"))
(should (tramp-tramp-file-p "/[method/user@host]"))
(should (tramp-tramp-file-p "/[method/user@email@host]"))
(should (tramp-tramp-file-p "/[method/host#1234]"))
(should (tramp-tramp-file-p "/[method/user@host#1234]"))
(should (tramp-tramp-file-p "/[method/1.2.3.4]"))
(should (tramp-tramp-file-p "/[method/user@1.2.3.4]"))
(should (tramp-tramp-file-p "/[method/::1]"))
(should (tramp-tramp-file-p "/[method/user@::1]"))
(should (tramp-tramp-file-p "/[method/::ffff:1.2.3.4]"))
(should (tramp-tramp-file-p "/[method/user@::ffff:1.2.3.4]"))
(should (tramp-tramp-file-p "/[method/]"))
(should (tramp-tramp-file-p "/[method/]/:"))
(should (tramp-tramp-file-p "/[method/]/path/to/file"))
(should (tramp-tramp-file-p "/[method/]/:/path/to/file"))
(should (tramp-tramp-file-p "/[method/]file"))
(should (tramp-tramp-file-p "/[method/]/:file"))
(should (tramp-tramp-file-p "/[method1/|method2/]"))
(should (tramp-tramp-file-p "/[method1/host1|method2/host2]"))
(should
(tramp-tramp-file-p
"/[method1/user1@host1|method2/user2@host2]"))
(should
(tramp-tramp-file-p
"/[method1/user1@host1|method2/user2@host2|method3/user3@host3]"))
(should-not (tramp-tramp-file-p nil))
(should-not (tramp-tramp-file-p 'symbol))
(should-not (tramp-tramp-file-p "/host:"))
(should-not (tramp-tramp-file-p "/user@host:"))
(should-not (tramp-tramp-file-p "/1.2.3.4:"))
(should-not (tramp-tramp-file-p "/host:/:"))
(should-not (tramp-tramp-file-p "/host1|host2:"))
(should-not (tramp-tramp-file-p "/user1@host1|user2@host2:"))
(should-not (tramp-tramp-file-p "/:[]")))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test02-file-name-dissect ()
"Check remote file name components."
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
(non-essential t)
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))
(syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'default)
(let (non-essential)
(should-error
(expand-file-name "/method:user@host:")
:type 'user-error))
(should
(string-equal
(file-remote-p "/method::")
(format "/%s:%s@%s:" "method" "default-user" "default-host")))
(should (string-equal (file-remote-p "/method::" 'method) "method"))
(should
(string-equal (file-remote-p "/method::" 'user) "default-user"))
(should
(string-equal (file-remote-p "/method::" 'host) "default-host"))
(should (string-equal (file-remote-p "/method::" 'localname) ""))
(should (string-equal (file-remote-p "/method::" 'hop) nil))
(should
(string-equal
(file-remote-p "/-:host:")
(format "/%s:%s@%s:" "default-method" "default-user" "host")))
(should
(string-equal (file-remote-p "/-:host:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:host:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:host:" 'host) "host"))
(should (string-equal (file-remote-p "/-:host:" 'localname) ""))
(should (string-equal (file-remote-p "/-:host:" 'hop) nil))
(should
(string-equal
(file-remote-p "/-:user@:")
(format "/%s:%s@%s:" "default-method" "user" "default-host")))
(should
(string-equal (file-remote-p "/-:user@:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:user@:" 'user) "user"))
(should
(string-equal (file-remote-p "/-:user@:" 'host) "default-host"))
(should (string-equal (file-remote-p "/-:user@:" 'localname) ""))
(should (string-equal (file-remote-p "/-:user@:" 'hop) nil))
(should (string-equal
(file-remote-p "/-:user@host:")
(format "/%s:%s@%s:" "default-method" "user" "host")))
(should (string-equal
(file-remote-p "/-:user@host:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:user@host:" 'user) "user"))
(should (string-equal (file-remote-p "/-:user@host:" 'host) "host"))
(should (string-equal (file-remote-p "/-:user@host:" 'localname) ""))
(should (string-equal (file-remote-p "/-:user@host:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:host:")
(format "/%s:%s@%s:" "method" "default-user" "host")))
(should
(string-equal (file-remote-p "/method:host:" 'method) "method"))
(should
(string-equal (file-remote-p "/method:host:" 'user) "default-user"))
(should (string-equal (file-remote-p "/method:host:" 'host) "host"))
(should (string-equal (file-remote-p "/method:host:" 'localname) ""))
(should (string-equal (file-remote-p "/method:host:" 'hop) nil))
(should
(string-equal
(file-remote-p "/method:user@:")
(format "/%s:%s@%s:" "method" "user" "default-host")))
(should
(string-equal (file-remote-p "/method:user@:" 'method) "method"))
(should (string-equal (file-remote-p "/method:user@:" 'user) "user"))
(should
(string-equal (file-remote-p "/method:user@:" 'host) "default-host"))
(should (string-equal (file-remote-p "/method:user@:" 'localname) ""))
(should (string-equal (file-remote-p "/method:user@:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:user@host:")
(format "/%s:%s@%s:" "method" "user" "host")))
(should (string-equal
(file-remote-p "/method:user@host:" 'method) "method"))
(should
(string-equal (file-remote-p "/method:user@host:" 'user) "user"))
(should
(string-equal (file-remote-p "/method:user@host:" 'host) "host"))
(should
(string-equal (file-remote-p "/method:user@host:" 'localname) ""))
(should (string-equal (file-remote-p "/method:user@host:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:user@email@host:")
(format "/%s:%s@%s:" "method" "user@email" "host")))
(should (string-equal
(file-remote-p "/method:user@email@host:" 'method) "method"))
(should
(string-equal
(file-remote-p "/method:user@email@host:" 'user) "user@email"))
(should (string-equal
(file-remote-p "/method:user@email@host:" 'host) "host"))
(should (string-equal
(file-remote-p "/method:user@email@host:" 'localname) ""))
(should (string-equal
(file-remote-p "/method:user@email@host:" 'hop) nil))
(should
(string-equal
(file-remote-p "/-:host#1234:")
(format "/%s:%s@%s:" "default-method" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/-:host#1234:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:host#1234:" 'user) "default-user"))
(should
(string-equal (file-remote-p "/-:host#1234:" 'host) "host#1234"))
(should (string-equal (file-remote-p "/-:host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/-:host#1234:" 'hop) nil))
(should (string-equal
(file-remote-p "/-:user@host#1234:")
(format "/%s:%s@%s:" "default-method" "user" "host#1234")))
(should
(string-equal
(file-remote-p "/-:user@host#1234:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:user@host#1234:" 'user) "user"))
(should
(string-equal
(file-remote-p "/-:user@host#1234:" 'host) "host#1234"))
(should
(string-equal (file-remote-p "/-:user@host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:host#1234:")
(format "/%s:%s@%s:" "method" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/method:host#1234:" 'method) "method"))
(should (string-equal
(file-remote-p "/method:host#1234:" 'user) "default-user"))
(should (string-equal
(file-remote-p "/method:host#1234:" 'host) "host#1234"))
(should
(string-equal (file-remote-p "/method:host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:user@host#1234:")
(format "/%s:%s@%s:" "method" "user" "host#1234")))
(should (string-equal
(file-remote-p "/method:user@host#1234:" 'method) "method"))
(should (string-equal
(file-remote-p "/method:user@host#1234:" 'user) "user"))
(should (string-equal
(file-remote-p "/method:user@host#1234:" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/method:user@host#1234:" 'localname) ""))
(should (string-equal
(file-remote-p "/method:user@host#1234:" 'hop) nil))
(should
(string-equal
(file-remote-p "/-:1.2.3.4:")
(format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4")))
(should
(string-equal
(file-remote-p "/-:1.2.3.4:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) ""))
(should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop) nil))
(should (string-equal
(file-remote-p "/-:user@1.2.3.4:")
(format "/%s:%s@%s:" "default-method" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/-:user@1.2.3.4:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:user@1.2.3.4:" 'user) "user"))
(should
(string-equal (file-remote-p "/-:user@1.2.3.4:" 'host) "1.2.3.4"))
(should
(string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname) ""))
(should
(string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:1.2.3.4:")
(format "/%s:%s@%s:" "method" "default-user" "1.2.3.4")))
(should
(string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method"))
(should (string-equal
(file-remote-p "/method:1.2.3.4:" 'user) "default-user"))
(should
(string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4"))
(should
(string-equal (file-remote-p "/method:1.2.3.4:" 'localname) ""))
(should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:")
(format "/%s:%s@%s:" "method" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:" 'method) "method"))
(should
(string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user"))
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:" 'hop) nil))
(should
(string-equal
(file-remote-p "/-:[]:")
(format
"/%s:%s@%s:" "default-method" "default-user" "default-host")))
(should
(string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:[]:" 'host) "default-host"))
(should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
(should (string-equal (file-remote-p "/-:[]:" 'hop) nil))
(let ((tramp-default-host "::1"))
(should
(string-equal
(file-remote-p "/-:[]:")
(format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
(should
(string-equal (file-remote-p "/-:[]:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:[]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:[]:" 'host) "::1"))
(should (string-equal (file-remote-p "/-:[]:" 'localname) ""))
(should (string-equal (file-remote-p "/-:[]:" 'hop) nil)))
(should
(string-equal
(file-remote-p "/-:[::1]:")
(format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
(should
(string-equal (file-remote-p "/-:[::1]:" 'method) "default-method"))
(should
(string-equal (file-remote-p "/-:[::1]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/-:[::1]:" 'host) "::1"))
(should (string-equal (file-remote-p "/-:[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/-:[::1]:" 'hop) nil))
(should (string-equal
(file-remote-p "/-:user@[::1]:")
(format "/%s:%s@%s:" "default-method" "user" "[::1]")))
(should (string-equal
(file-remote-p "/-:user@[::1]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/-:user@[::1]:" 'user) "user"))
(should (string-equal (file-remote-p "/-:user@[::1]:" 'host) "::1"))
(should (string-equal (file-remote-p "/-:user@[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/-:user@[::1]:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:[::1]:")
(format "/%s:%s@%s:" "method" "default-user" "[::1]")))
(should
(string-equal (file-remote-p "/method:[::1]:" 'method) "method"))
(should (string-equal
(file-remote-p "/method:[::1]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1"))
(should (string-equal (file-remote-p "/method:[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil))
(should (string-equal
(file-remote-p "/method:user@[::1]:")
(format "/%s:%s@%s:" "method" "user" "[::1]")))
(should (string-equal
(file-remote-p "/method:user@[::1]:" 'method) "method"))
(should
(string-equal (file-remote-p "/method:user@[::1]:" 'user) "user"))
(should
(string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1"))
(should (string-equal
(file-remote-p "/method:user@[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil))
(should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:"))
(should (string-equal (file-remote-p "/method:::" 'localname) ":"))
(should (string-equal (file-remote-p "/method:: " 'localname) " "))
(should
(string-equal (file-remote-p "/method::file" 'localname) "file"))
(should (string-equal
(file-remote-p "/method::/path/to/file" 'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file")
"/method2:user2@host2:"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
"method2"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
"user2"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
"host2"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file"
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
(format "%s:%s@%s|"
"method1" "user1" "host1")))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file"))
"/method3:user3@host3:"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file")
'method)
"method3"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file")
'user)
"user3"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file")
'host)
"host3"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file")
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file")
'hop)
(format "%s:%s@%s|%s:%s@%s|"
"method1" "user1" "host1" "method2" "user2" "host2")))
(add-to-list 'tramp-default-method-alist '("host1" "user1" "method1"))
(add-to-list 'tramp-default-method-alist '("host2" "user2" "method2"))
(add-to-list 'tramp-default-method-alist '("host3" "user3" "method3"))
(should
(string-equal
(file-remote-p
(concat
"/-:user1@host1"
"|-:user2@host2"
"|-:user3@host3:/path/to/file"))
"/method3:user3@host3:"))
(add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
(add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
(add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
(should
(string-equal
(file-remote-p
(concat
"/method1:host1"
"|method2:host2"
"|method3:host3:/path/to/file"))
"/method3:user3@host3:"))
(add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
(add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
(add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@"
"|method2:user2@"
"|method3:user3@:/path/to/file"))
"/method3:user3@host3:"))
(setq tramp-default-method-alist nil
tramp-default-user-alist nil
tramp-default-host-alist nil)
(should
(string-equal
(file-remote-p
(concat
"/method1:user1@host1"
"|method2:user2@"
"|method3:user3@:/path/to/file"))
"/method3:user3@host1:"))
(should
(string-equal
(file-remote-p
(concat
"/method1:%u@%h"
"|method2:user2@host2"
"|method3:%u@%h"
"|method4:user4%domain4@host4#1234:/path/to/file"))
"/method4:user4%domain4@host4#1234:")))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test02-file-name-dissect-simplified ()
"Check simplified file name components."
:tags '(:expensive-test)
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-user-alist
tramp-default-host-alist
(non-essential t)
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))
(syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'simplified)
(let (non-essential)
(should-error
(expand-file-name "/user@host:")
:type 'user-error))
(should (string-equal
(file-remote-p "/host:")
(format "/%s@%s:" "default-user" "host")))
(should (string-equal
(file-remote-p "/host:" 'method) "default-method"))
(should (string-equal (file-remote-p "/host:" 'user) "default-user"))
(should (string-equal (file-remote-p "/host:" 'host) "host"))
(should (string-equal (file-remote-p "/host:" 'localname) ""))
(should (string-equal (file-remote-p "/host:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@:")
(format "/%s@%s:" "user" "default-host")))
(should (string-equal
(file-remote-p "/user@:" 'method) "default-method"))
(should (string-equal (file-remote-p "/user@:" 'user) "user"))
(should (string-equal (file-remote-p "/user@:" 'host) "default-host"))
(should (string-equal (file-remote-p "/user@:" 'localname) ""))
(should (string-equal (file-remote-p "/user@:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@host:")
(format "/%s@%s:" "user" "host")))
(should (string-equal
(file-remote-p "/user@host:" 'method) "default-method"))
(should (string-equal (file-remote-p "/user@host:" 'user) "user"))
(should (string-equal (file-remote-p "/user@host:" 'host) "host"))
(should (string-equal (file-remote-p "/user@host:" 'localname) ""))
(should (string-equal (file-remote-p "/user@host:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@email@host:")
(format "/%s@%s:" "user@email" "host")))
(should (string-equal
(file-remote-p "/user@email@host:" 'method) "default-method"))
(should (string-equal
(file-remote-p "/user@email@host:" 'user) "user@email"))
(should (string-equal
(file-remote-p "/user@email@host:" 'host) "host"))
(should (string-equal
(file-remote-p "/user@email@host:" 'localname) ""))
(should (string-equal
(file-remote-p "/user@email@host:" 'hop) nil))
(should (string-equal
(file-remote-p "/host#1234:")
(format "/%s@%s:" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/host#1234:" 'method) "default-method"))
(should (string-equal
(file-remote-p "/host#1234:" 'user) "default-user"))
(should (string-equal
(file-remote-p "/host#1234:" 'host) "host#1234"))
(should (string-equal (file-remote-p "/host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/host#1234:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@host#1234:")
(format "/%s@%s:" "user" "host#1234")))
(should (string-equal
(file-remote-p "/user@host#1234:" 'method) "default-method"))
(should (string-equal
(file-remote-p "/user@host#1234:" 'user) "user"))
(should (string-equal
(file-remote-p "/user@host#1234:" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/user@host#1234:" 'localname) ""))
(should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil))
(should (string-equal
(file-remote-p "/1.2.3.4:")
(format "/%s@%s:" "default-user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/1.2.3.4:" 'method) "default-method"))
(should (string-equal
(file-remote-p "/1.2.3.4:" 'user) "default-user"))
(should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/1.2.3.4:" 'localname) ""))
(should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@1.2.3.4:")
(format "/%s@%s:" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/user@1.2.3.4:" 'method) "default-method"))
(should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user"))
(should (string-equal
(file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) ""))
(should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil))
(should (string-equal
(file-remote-p "/[]:")
(format
"/%s@%s:" "default-user" "default-host")))
(should (string-equal
(file-remote-p "/[]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
(should (string-equal (file-remote-p "/[]:" 'localname) ""))
(should (string-equal (file-remote-p "/[]:" 'hop) nil))
(let ((tramp-default-host "::1"))
(should (string-equal
(file-remote-p "/[]:")
(format "/%s@%s:" "default-user" "[::1]")))
(should (string-equal
(file-remote-p "/[]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/[]:" 'host) "::1"))
(should (string-equal (file-remote-p "/[]:" 'localname) ""))
(should (string-equal (file-remote-p "/[]:" 'hop) nil)))
(should (string-equal
(file-remote-p "/[::1]:")
(format "/%s@%s:" "default-user" "[::1]")))
(should (string-equal
(file-remote-p "/[::1]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/[::1]:" 'user) "default-user"))
(should (string-equal (file-remote-p "/[::1]:" 'host) "::1"))
(should (string-equal (file-remote-p "/[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/[::1]:" 'hop) nil))
(should (string-equal
(file-remote-p "/user@[::1]:")
(format "/%s@%s:" "user" "[::1]")))
(should (string-equal
(file-remote-p "/user@[::1]:" 'method) "default-method"))
(should (string-equal (file-remote-p "/user@[::1]:" 'user) "user"))
(should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1"))
(should (string-equal (file-remote-p "/user@[::1]:" 'localname) ""))
(should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil))
(should (string-equal (file-remote-p "/host:/:" 'localname) "/:"))
(should (string-equal (file-remote-p "/host::" 'localname) ":"))
(should (string-equal (file-remote-p "/host: " 'localname) " "))
(should (string-equal (file-remote-p "/host:file" 'localname) "file"))
(should (string-equal
(file-remote-p "/host:/path/to/file" 'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p "/user1@host1|user2@host2:/path/to/file")
"/user2@host2:"))
(should
(string-equal
(file-remote-p
"/user1@host1|user2@host2:/path/to/file" 'method)
"default-method"))
(should
(string-equal
(file-remote-p
"/user1@host1|user2@host2:/path/to/file" 'user)
"user2"))
(should
(string-equal
(file-remote-p
"/user1@host1|user2@host2:/path/to/file" 'host)
"host2"))
(should
(string-equal
(file-remote-p
"/user1@host1|user2@host2:/path/to/file" 'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
"/user1@host1|user2@host2:/path/to/file" 'hop)
(format "%s@%s|" "user1" "host1")))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file"))
"/user3@host3:"))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file")
'method)
"default-method"))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file")
'user)
"user3"))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file")
'host)
"host3"))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file")
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file")
'hop)
(format "%s@%s|%s@%s|"
"user1" "host1" "user2" "host2")))
(add-to-list 'tramp-default-user-alist '(nil "host1" "user1"))
(add-to-list 'tramp-default-user-alist '(nil "host2" "user2"))
(add-to-list 'tramp-default-user-alist '(nil "host3" "user3"))
(should
(string-equal
(file-remote-p
(concat
"/host1"
"|host2"
"|host3:/path/to/file"))
"/user3@host3:"))
(add-to-list 'tramp-default-host-alist '(nil "user1" "host1"))
(add-to-list 'tramp-default-host-alist '(nil "user2" "host2"))
(add-to-list 'tramp-default-host-alist '(nil "user3" "host3"))
(should
(string-equal
(file-remote-p
(concat
"/user1@"
"|user2@"
"|user3@:/path/to/file"))
"/user3@host3:"))
(setq tramp-default-user-alist nil
tramp-default-host-alist nil)
(should
(string-equal
(file-remote-p
(concat
"/user1@host1"
"|user2@"
"|user3@:/path/to/file"))
"/user3@host1:"))
(should
(string-equal
(file-remote-p
(concat
"/%u@%h"
"|user2@host2"
"|%u@%h"
"|user4%domain4@host4#1234:/path/to/file"))
"/user4%domain4@host4#1234:")))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test02-file-name-dissect-separate ()
"Check separate file name components."
:tags '(:expensive-test)
(let ((tramp-default-method "default-method")
(tramp-default-user "default-user")
(tramp-default-host "default-host")
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
(non-essential t)
(tramp-cache-data (make-hash-table :test #'equal))
(tramp-connection-properties '((nil "login-program" t)))
(syntax tramp-syntax))
(unwind-protect
(progn
(tramp-change-syntax 'separate)
(let (non-essential)
(should-error
(expand-file-name "/[method/user@host]")
:type 'user-error))
(should (string-equal
(file-remote-p "/[method/]")
(format
"/[%s/%s@%s]" "method" "default-user" "default-host")))
(should (string-equal (file-remote-p "/[method/]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[method/]" 'host) "default-host"))
(should (string-equal (file-remote-p "/[method/]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/host]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "host")))
(should (string-equal
(file-remote-p "/[/host]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/host]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[/host]" 'host) "host"))
(should (string-equal (file-remote-p "/[/host]" 'localname) ""))
(should (string-equal (file-remote-p "/[/host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/user@]")
(format
"/[%s/%s@%s]" "default-method" "user" "default-host")))
(should (string-equal
(file-remote-p "/[/user@]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[/user@]" 'user) "user"))
(should (string-equal
(file-remote-p "/[/user@]" 'host) "default-host"))
(should (string-equal (file-remote-p "/[/user@]" 'localname) ""))
(should (string-equal (file-remote-p "/[/user@]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/user@host]")
(format "/[%s/%s@%s]" "default-method" "user" "host")))
(should (string-equal
(file-remote-p "/[/user@host]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[/user@host]" 'user) "user"))
(should (string-equal (file-remote-p "/[/user@host]" 'host) "host"))
(should (string-equal (file-remote-p "/[/user@host]" 'localname) ""))
(should (string-equal (file-remote-p "/[/user@host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/host]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "host")))
(should (string-equal
(file-remote-p "/[-/host]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[-/host]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[-/host]" 'host) "host"))
(should (string-equal (file-remote-p "/[-/host]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/user@]")
(format
"/[%s/%s@%s]" "default-method" "user" "default-host")))
(should (string-equal
(file-remote-p "/[-/user@]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[-/user@]" 'user) "user"))
(should (string-equal
(file-remote-p "/[-/user@]" 'host) "default-host"))
(should (string-equal (file-remote-p "/[-/user@]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/user@]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/user@host]")
(format "/[%s/%s@%s]" "default-method" "user" "host")))
(should (string-equal
(file-remote-p "/[-/user@host]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[-/user@host]" 'user) "user"))
(should (string-equal (file-remote-p "/[-/user@host]" 'host) "host"))
(should (string-equal (file-remote-p "/[-/user@host]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/user@host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/host]")
(format "/[%s/%s@%s]" "method" "default-user" "host")))
(should (string-equal
(file-remote-p "/[method/host]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/host]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[method/host]" 'host) "host"))
(should (string-equal (file-remote-p "/[method/host]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@]")
(format "/[%s/%s@%s]" "method" "user" "default-host")))
(should (string-equal
(file-remote-p "/[method/user@]" 'method) "method"))
(should (string-equal (file-remote-p "/[method/user@]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@]" 'host) "default-host"))
(should (string-equal
(file-remote-p "/[method/user@]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/user@]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@host]")
(format "/[%s/%s@%s]" "method" "user" "host")))
(should (string-equal
(file-remote-p "/[method/user@host]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@host]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@host]" 'host) "host"))
(should (string-equal
(file-remote-p "/[method/user@host]" 'localname) ""))
(should (string-equal
(file-remote-p "/[method/user@host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@email@host]")
(format "/[%s/%s@%s]" "method" "user@email" "host")))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'user)
"user@email"))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'host) "host"))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'localname) ""))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/host#1234]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/[/host#1234]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/host#1234]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[/host#1234]" 'host) "host#1234"))
(should (string-equal (file-remote-p "/[/host#1234]" 'localname) ""))
(should (string-equal (file-remote-p "/[/host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'localname) ""))
(should (string-equal (file-remote-p "/[/user@host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/host#1234]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/[-/host#1234]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[-/host#1234]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[-/host#1234]" 'host) "host#1234"))
(should (string-equal (file-remote-p "/[-/host#1234]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/host#1234]")
(format "/[%s/%s@%s]" "method" "default-user" "host#1234")))
(should (string-equal
(file-remote-p "/[method/host#1234]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/host#1234]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[method/host#1234]" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/[method/host#1234]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@host#1234]")
(format "/[%s/%s@%s]" "method" "user" "host#1234")))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'host) "host#1234"))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'localname) ""))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/1.2.3.4]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[/1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/1.2.3.4]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[/1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname) ""))
(should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'localname) ""))
(should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/1.2.3.4]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[-/1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[-/1.2.3.4]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[-/1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/1.2.3.4]")
(format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[method/1.2.3.4]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/1.2.3.4]" 'user) "default-user"))
(should (string-equal
(file-remote-p "/[method/1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal
(file-remote-p "/[method/1.2.3.4]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]")
(format "/[%s/%s@%s]" "method" "user" "1.2.3.4")))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]" 'host) "1.2.3.4"))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]" 'localname) ""))
(should (string-equal
(file-remote-p "/[method/user@1.2.3.4]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/]")
(format
"/[%s/%s@%s]"
"default-method" "default-user" "default-host")))
(should (string-equal
(file-remote-p "/[/]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[/]" 'host) "default-host"))
(should (string-equal (file-remote-p "/[/]" 'localname) ""))
(should (string-equal (file-remote-p "/[/]" 'hop) nil))
(let ((tramp-default-host "::1"))
(should (string-equal
(file-remote-p "/[/]")
(format
"/[%s/%s@%s]"
"default-method" "default-user" "::1")))
(should (string-equal
(file-remote-p "/[/]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[/]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[/]" 'host) "::1"))
(should (string-equal (file-remote-p "/[/]" 'localname) ""))
(should (string-equal (file-remote-p "/[/]" 'hop) nil)))
(should (string-equal
(file-remote-p "/[/::1]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "::1")))
(should (string-equal
(file-remote-p "/[/::1]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/::1]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[/::1]" 'host) "::1"))
(should (string-equal (file-remote-p "/[/::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[/::1]" 'hop) nil))
(should (string-equal
(file-remote-p "/[/user@::1]")
(format "/[%s/%s@%s]" "default-method" "user" "::1")))
(should (string-equal
(file-remote-p "/[/user@::1]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[/user@::1]" 'user) "user"))
(should (string-equal (file-remote-p "/[/user@::1]" 'host) "::1"))
(should (string-equal (file-remote-p "/[/user@::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[/user@::1]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/]")
(format
"/[%s/%s@%s]"
"default-method" "default-user" "default-host")))
(should (string-equal
(file-remote-p "/[-/]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[-/]" 'host) "default-host"))
(should (string-equal (file-remote-p "/[-/]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/]" 'hop) nil))
(let ((tramp-default-host "::1"))
(should (string-equal
(file-remote-p "/[-/]")
(format
"/[%s/%s@%s]"
"default-method" "default-user" "::1")))
(should (string-equal
(file-remote-p "/[-/]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[-/]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[-/]" 'host) "::1"))
(should (string-equal (file-remote-p "/[-/]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/]" 'hop) nil)))
(should (string-equal
(file-remote-p "/[-/::1]")
(format
"/[%s/%s@%s]" "default-method" "default-user" "::1")))
(should (string-equal
(file-remote-p "/[-/::1]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[-/::1]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[-/::1]" 'host) "::1"))
(should (string-equal (file-remote-p "/[-/::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/::1]" 'hop) nil))
(should (string-equal
(file-remote-p "/[-/user@::1]")
(format "/[%s/%s@%s]" "default-method" "user" "::1")))
(should (string-equal
(file-remote-p "/[-/user@::1]" 'method) "default-method"))
(should (string-equal (file-remote-p "/[-/user@::1]" 'user) "user"))
(should (string-equal (file-remote-p "/[-/user@::1]" 'host) "::1"))
(should (string-equal (file-remote-p "/[-/user@::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[-/user@::1]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/::1]")
(format "/[%s/%s@%s]" "method" "default-user" "::1")))
(should (string-equal
(file-remote-p "/[method/::1]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/::1]" 'user) "default-user"))
(should (string-equal (file-remote-p "/[method/::1]" 'host) "::1"))
(should (string-equal (file-remote-p "/[method/::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/::1]" 'hop) nil))
(should (string-equal
(file-remote-p "/[method/user@::1]")
(format "/[%s/%s@%s]" "method" "user" "::1")))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'method) "method"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'user) "user"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'host) "::1"))
(should (string-equal
(file-remote-p "/[method/user@::1]" 'localname) ""))
(should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil))
(should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:"))
(should (string-equal (file-remote-p "/[-/host]/:" 'localname) "/:"))
(should (string-equal (file-remote-p "/[method/]:" 'localname) ":"))
(should (string-equal (file-remote-p "/[method/] " 'localname) " "))
(should (string-equal
(file-remote-p "/[method/]file" 'localname) "file"))
(should (string-equal
(file-remote-p "/[method/]/path/to/file" 'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file")
"/[method2/user2@host2]"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method)
"method2"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
"user2"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
"host2"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file"
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
(format "%s/%s@%s|"
"method1" "user1" "host1")))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file"))
"/[method3/user3@host3]"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file")
'method)
"method3"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file")
'user)
"user3"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file")
'host)
"host3"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file")
'localname)
"/path/to/file"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file")
'hop)
(format "%s/%s@%s|%s/%s@%s|"
"method1" "user1" "host1" "method2" "user2" "host2")))
(add-to-list 'tramp-default-method-alist '("host1" "user1" "method1"))
(add-to-list 'tramp-default-method-alist '("host2" "user2" "method2"))
(add-to-list 'tramp-default-method-alist '("host3" "user3" "method3"))
(should
(string-equal
(file-remote-p
(concat
"/[/user1@host1"
"|/user2@host2"
"|/user3@host3]/path/to/file"))
"/[method3/user3@host3]"))
(add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
(add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
(add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/host1"
"|method2/host2"
"|method3/host3]/path/to/file"))
"/[method3/user3@host3]"))
(add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
(add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
(add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@"
"|method2/user2@"
"|method3/user3@]/path/to/file"))
"/[method3/user3@host3]"))
(setq tramp-default-method-alist nil
tramp-default-user-alist nil
tramp-default-host-alist nil)
(should
(string-equal
(file-remote-p
(concat
"/[method1/user1@host1"
"|method2/user2@"
"|method3/user3@]/path/to/file"))
"/[method3/user3@host1]"))
(should
(string-equal
(file-remote-p
(concat
"/[method1/%u@%h"
"|method2/user2@host2"
"|method3/%u@%h"
"|method4/user4%domain4@host4#1234]/path/to/file"))
"/[method4/user4%domain4@host4#1234]")))
(tramp-change-syntax syntax))))
(ert-deftest tramp-test03-file-name-defaults ()
"Check default values for some methods."
(skip-unless (eq tramp-syntax 'default))
(when (assoc "adb" tramp-methods)
(should (string-equal (file-remote-p "/adb::" 'host) "")))
(when (assoc "ftp" tramp-methods)
(should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp"))
(dolist (u '("ftp" "anonymous"))
(should
(string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))))
(when (assoc "su" tramp-methods)
(dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
(should
(string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))
(dolist (m '("su" "sudo" "ksu" "doas" "sudoedit"))
(should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))
(should
(string-equal (file-remote-p (format "/%s::" m) 'host) (system-name))))
(dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc"))
(should
(string-equal
(file-remote-p (format "/%s::" m) 'user) (user-login-name)))))
(when (assoc "smb" tramp-methods)
(should (string-equal (file-remote-p "/smb::" 'user) nil))))
(ert-deftest tramp-test03-file-name-host-rules ()
"Check host name rules for host-less methods."
(skip-unless (eq tramp-syntax 'default))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
(let (tramp-connection-properties tramp-default-proxies-alist)
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password))
(should-error
(find-file (format "/%s:foo:" m))
:type 'user-error)
(should-error
(find-file
(format
"%s|%s:foo:"
(substring (file-remote-p ert-remote-temporary-file-directory) 0 -1)
m))
:type 'user-error))))
(ert-deftest tramp-test03-file-name-method-rules ()
"Check file name rules for some methods."
(skip-unless (eq tramp-syntax 'default))
(skip-unless (tramp--test-enabled))
(let (non-essential)
(should-error
(expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file")
:type 'user-error)
(should-error
(expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file")
:type 'user-error)))
(ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'."
(skip-unless (eq tramp-syntax 'default))
(let ((tramp-methods (cons '("method") tramp-methods))
(foo (downcase (md5 (current-time-string)))))
(should
(string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
(should
(string-equal
(substitute-in-file-name "/method:host://foo") "/method:host:/foo"))
(should
(string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:///foo")
"/method:host:/:///foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:/path///foo")
"/method:host:/:/path///foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:/path//foo")
"/method:host:/:/path//foo"))
(should
(string-equal
(substitute-in-file-name (concat "/method:host://~" foo))
(concat "/~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/~" foo))
(concat "/method:host:/~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/path//~" foo))
(concat "/~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/path/~" foo))
(concat "/method:host:/path/~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/://~" foo))
(concat "/method:host:/://~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/:/~" foo))
(concat "/method:host:/:/~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/:/path//~" foo))
(concat "/method:host:/:/path//~" foo)))
(should
(string-equal
(substitute-in-file-name (concat "/method:host:/:/path/~" foo))
(concat "/method:host:/:/path/~" foo)))
(let (process-environment)
(should
(string-equal
(substitute-in-file-name "/method:host:/path/$FOO")
"/method:host:/path/$FOO"))
(setenv "FOO" "bla")
(should
(string-equal
(substitute-in-file-name "/method:host:/path/$FOO")
"/method:host:/path/bla"))
(should
(string-equal
(substitute-in-file-name "/method:host:/path/$$FOO")
"/method:host:/path/$FOO"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:/path/$FOO")
"/method:host:/:/path/$FOO"))
(setenv "FOO" "bla")
(should
(string-equal
(substitute-in-file-name "/method:host:/:/path/$FOO")
"/method:host:/:/path/$FOO"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:/path/$$FOO")
"/method:host:/:/path/$$FOO")))))
(ert-deftest tramp-test05-expand-file-name ()
"Check `expand-file-name'."
(skip-unless (eq tramp-syntax 'default))
(let ((tramp-methods (cons '("method") tramp-methods)))
(should
(string-equal
(expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
(should
(string-equal
(expand-file-name "/method:host:/path/../file") "/method:host:/file"))
(should
(string-equal
(expand-file-name "/method:host:/path/.") "/method:host:/path"))
(should
(string-equal
(expand-file-name "/method:host:/path/..") "/method:host:/"))
(should
(string-equal
(expand-file-name "." "/method:host:/path/") "/method:host:/path"))
(should
(string-equal
(expand-file-name "" "/method:host:/path/") "/method:host:/path"))
(should
(string-equal
(expand-file-name "/method:host:/:/path/./file")
"/method:host:/:/path/file"))
(should
(string-equal
(expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
(should
(string-equal
(expand-file-name "/method:host:/:/~/path/./file")
"/method:host:/:/~/path/file"))))
(ert-deftest tramp-test05-expand-file-name-relative ()
"Check `expand-file-name'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-share-p)))
(skip-unless (tramp--test-emacs28-p))
(should
(string-equal
(let ((default-directory
(concat
(file-remote-p ert-remote-temporary-file-directory) "/path")))
(expand-file-name ".." "./"))
(concat (file-remote-p ert-remote-temporary-file-directory) "/"))))
(ert-deftest tramp-test05-expand-file-name-top ()
"Check `expand-file-name'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(let ((dir (concat (file-remote-p ert-remote-temporary-file-directory) "/")))
(dolist (local '("." ".."))
(should (string-equal (expand-file-name local dir) dir))
(should (string-equal (expand-file-name (concat dir local)) dir)))))
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
`file-name-nondirectory' and `unhandled-file-name-directory'."
(skip-unless (eq tramp-syntax 'default))
(let ((tramp-methods (cons '("method") tramp-methods)))
(should
(string-equal
(directory-file-name "/method:host:/path/to/file")
"/method:host:/path/to/file"))
(should
(string-equal
(directory-file-name "/method:host:/path/to/file/")
"/method:host:/path/to/file"))
(should
(string-equal
(directory-file-name "/method:host:/path/to/file//")
"/method:host:/path/to/file"))
(should
(string-equal
(file-name-as-directory "/method:host:/path/to/file")
"/method:host:/path/to/file/"))
(should
(string-equal
(file-name-as-directory "/method:host:/path/to/file/")
"/method:host:/path/to/file/"))
(should
(string-equal
(file-name-directory "/method:host:/path/to/file")
"/method:host:/path/to/"))
(should
(string-equal
(file-name-directory "/method:host:/path/to/file/")
"/method:host:/path/to/file/"))
(should
(string-equal (file-name-directory "/method:host:file") "/method:host:"))
(should
(string-equal
(file-name-directory "/method:host:path/") "/method:host:path/"))
(should
(string-equal
(file-name-directory "/method:host:path/to") "/method:host:path/"))
(should
(string-equal
(file-name-nondirectory "/method:host:/path/to/file") "file"))
(should
(string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
(should-not
(unhandled-file-name-directory "/method:host:/path/to/file")))
(when (tramp--test-enabled) (dolist (non-essential '(nil t))
(let ((tramp-default-method
(file-remote-p ert-remote-temporary-file-directory 'method))
(host (file-remote-p ert-remote-temporary-file-directory 'host)))
(dolist
(file
`(,(format "/%s::" tramp-default-method)
,(format
"/-:%s:"
(if (string-match-p tramp-ipv6-regexp host)
(concat
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host))))
(should (string-equal (directory-file-name file) file))
(should
(string-equal
(file-name-as-directory file)
(if non-essential
file (concat file (if (tramp--test-ange-ftp-p) "/" "./")))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
(ert-deftest tramp-test07-abbreviate-file-name ()
"Check that Tramp abbreviates file names correctly."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(skip-unless (tramp--test-emacs29-p))
(file-truename ert-remote-temporary-file-directory)
(let* ((remote-host (file-remote-p ert-remote-temporary-file-directory))
(remote-host-nohop
(tramp-make-tramp-file-name (tramp-dissect-file-name remote-host)))
(home-dir (ignore-errors (expand-file-name (concat remote-host "~"))))
home-dir-nohop)
(skip-unless home-dir)
(unless (string-suffix-p "~" home-dir)
(should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
(concat remote-host-nohop "~/foo/bar")))
(should (equal (abbreviate-file-name
(concat remote-host "/nowhere/special"))
(concat remote-host-nohop "/nowhere/special"))))
(let ((directory-abbrev-alist
`((,(tramp-compat-rx bos (literal home-dir) "/foo")
. ,(concat home-dir "/f"))
(,(tramp-compat-rx bos (literal remote-host) "/nowhere")
. ,(concat remote-host "/nw")))))
(should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
(concat remote-host-nohop "~/f/bar")))
(should (equal (abbreviate-file-name
(concat remote-host "/nowhere/special"))
(concat remote-host-nohop "/nw/special"))))
(setq home-dir (concat remote-host "/")
home-dir-nohop
(tramp-make-tramp-file-name (tramp-dissect-file-name home-dir)))
(tramp-set-connection-property tramp-test-vec "~" (file-local-name home-dir))
(should (equal (abbreviate-file-name (concat home-dir "foo/bar"))
(concat home-dir-nohop "foo/bar")))
(tramp-flush-connection-property tramp-test-vec "~")))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(delete-file tmp-name)
(should-not (file-exists-p tmp-name))
(unless (or (fboundp 'system-move-file-to-trash) (tramp--test-crypt-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(delete-file tmp-name 'trash)
(should-not (file-exists-p tmp-name))
(should
(or (file-exists-p
(expand-file-name
(file-name-nondirectory tmp-name) trash-directory))
(file-symlink-p
(expand-file-name
(file-name-nondirectory tmp-name) trash-directory))))
(delete-directory trash-directory 'recursive)
(should-not (file-exists-p trash-directory)))))))
(ert-deftest tramp-test08-file-local-copy ()
"Check `file-local-copy'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
tmp-name2)
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(should (setq tmp-name2 (file-local-copy tmp-name1)))
(with-temp-buffer
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo")))
(let ((default-directory ert-remote-temporary-file-directory)
(tramp-copy-size-limit 4)
(tramp-inline-compress-start-size 2))
(delete-file tmp-name2)
(should (setq tmp-name2 (file-local-copy tmp-name1))))
(delete-file tmp-name1)
(delete-file tmp-name2)
(should-error
(setq tmp-name2 (file-local-copy tmp-name1))
:type 'file-missing))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2))))))
(ert-deftest tramp-test09-insert-file-contents ()
"Check `insert-file-contents'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(let ((point (point)))
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
(goto-char (1+ (point)))
(let ((point (point)))
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "ffoooo"))
(should (= point (point))))
(let ((point (point)))
(insert-file-contents tmp-name nil 1 3)
(should (string-equal (buffer-string) "foofoooo"))
(should (= point (point))))
(let ((point (point)))
(insert-file-contents tmp-name nil nil nil 'replace)
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
(delete-file tmp-name)
(should-error
(insert-file-contents tmp-name)
:type 'file-missing))
(ignore-errors (delete-file tmp-name))))))
(ert-deftest tramp-test10-write-region ()
"Check `write-region'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(inhibit-message t))
(unwind-protect
(progn
(with-temp-buffer
(insert "foo")
(write-region nil nil tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
(delete-file tmp-name)
(with-temp-buffer
(insert "foo")
(should-not (file-exists-p tmp-name))
(let ((default-directory (file-name-directory tmp-name)))
(should-not (file-exists-p (file-name-nondirectory tmp-name)))
(write-region nil nil (file-name-nondirectory tmp-name))
(should (file-exists-p (file-name-nondirectory tmp-name))))
(should (file-exists-p tmp-name)))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
(unless (tramp--test-ange-ftp-p)
(with-temp-buffer
(insert "bla")
(write-region nil nil tmp-name 'append))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foobla")))
(with-temp-buffer
(insert "baz")
(write-region nil nil tmp-name 3))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foobaz")))
(delete-file tmp-name)
(with-temp-buffer
(insert "foo")
(write-region nil nil tmp-name 'append))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo"))))
(write-region "foo" nil tmp-name)
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
(when (fboundp 'make-empty-file)
(with-no-warnings
(should-error
(make-empty-file tmp-name)
:type 'file-already-exists)
(delete-file tmp-name)
(make-empty-file tmp-name)
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "")))))
(with-temp-buffer
(insert "123456789")
(write-region 3 5 tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "34")))
(let (inhibit-message)
(dolist (noninteractive (unless (tramp--test-ange-ftp-p) '(nil t)))
(dolist (visit '(nil t "string" no-message))
(ert-with-message-capture tramp--test-messages
(write-region "foo" nil tmp-name nil visit)
(should
(string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(tramp-compat-rx
bol "Wrote " (literal tmp-name) "\n" eos)
(rx bos))
tramp--test-messages))))))
(cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
((symbol-function 'yes-or-no-p) #'tramp--test-always))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
(should-error
(cl-letf (((symbol-function #'y-or-n-p) #'ignore)
((symbol-function #'yes-or-no-p) #'ignore))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
:type 'file-already-exists)
(should-error
(write-region "foo" nil tmp-name nil nil nil 'excl)
:type 'file-already-exists))
(ignore-errors (delete-file tmp-name))))))
(ert-deftest tramp-test10-write-region-file-precious-flag ()
"Check that `file-precious-flag' is respected with Tramp in use."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp--test-emacs27-p))
(let* ((tmp-name (tramp--test-make-temp-name))
(inhibit-message t)
written-files
(advice (lambda (_start _end filename &rest _r)
(push filename written-files))))
(unwind-protect
(with-current-buffer (find-file-noselect tmp-name)
(insert "foo")
(write-region nil nil tmp-name)
(set-visited-file-modtime)
(advice-add 'write-region :before advice)
(setq-local file-precious-flag t)
(setq-local backup-inhibited t)
(insert "bar")
(should (buffer-modified-p))
(should (null (save-buffer)))
(should (not (buffer-modified-p)))
(should-not (cl-member tmp-name written-files :test #'string=)))
(ignore-errors (advice-remove 'write-region advice))
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test10-write-region-other-file-name-handler ()
"Check that another file name handler in VISIT is acknowledged."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(skip-unless (executable-find "gzip"))
(skip-unless (boundp 'tar-goto-file))
(let* ((default-directory ert-remote-temporary-file-directory)
(archive (ert-resource-file "foo.tar.gz"))
(tmp-file (expand-file-name (file-name-nondirectory archive)))
(require-final-newline t)
(inhibit-message t)
(backup-inhibited t)
create-lockfiles buffer1 buffer2)
(unwind-protect
(progn
(copy-file archive tmp-file 'ok)
(with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
(with-no-warnings (should (tar-goto-file "foo.txt")))
(save-current-buffer
(setq buffer2 (tar-extract))
(should (string-equal (buffer-string) "foo\n"))
(goto-char (point-max))
(insert "bar")
(should (buffer-modified-p))
(should (null (save-buffer)))
(should-not (buffer-modified-p)))
(should (buffer-modified-p))
(should (null (save-buffer)))
(should-not (buffer-modified-p)))
(kill-buffer buffer1)
(kill-buffer buffer2)
(with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
(with-no-warnings (should (tar-goto-file "foo.txt")))
(save-current-buffer
(setq buffer2 (tar-extract))
(should (string-equal (buffer-string) "foo\nbar\n")))))
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2))
(ignore-errors (delete-file tmp-file)))))
(ert-deftest tramp-test11-copy-file ()
"Check `copy-file'."
(skip-unless (tramp--test-enabled))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(dolist (source-target
`( (,tmp-name1 . ,tmp-name2)
(,tmp-name1 . ,tmp-name3)
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(unwind-protect
(progn
(should-error
(copy-file source target)
:type 'file-missing)
(write-region "foo" nil source)
(should (file-exists-p source))
(copy-file source target)
(should (file-exists-p target))
(with-temp-buffer
(insert-file-contents target)
(should (string-equal (buffer-string) "foo")))
(when (tramp--test-expensive-test-p)
(should-error
(copy-file source target)
:type 'file-already-exists))
(copy-file source target 'ok))
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(write-region "foo" nil source)
(should (file-exists-p source))
(make-directory target)
(should (file-directory-p target))
(when (tramp--test-expensive-test-p)
(should-error
(copy-file source target)
:type 'file-already-exists)
(should-error
(copy-file source target 'ok)
:type 'file-error))
(copy-file source (file-name-as-directory target))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory source) target))))
(ignore-errors (delete-file source))
(ignore-errors (delete-directory target 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
(should (file-exists-p (expand-file-name "foo" source)))
(make-directory target)
(should (file-directory-p target))
(copy-file source (file-name-as-directory target))
(should
(file-exists-p
(expand-file-name
(concat (file-name-nondirectory source) "/foo") target))))
(ignore-errors (delete-directory source 'recursive))
(ignore-errors (delete-directory target 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
(should (file-exists-p (expand-file-name "foo" source)))
(make-directory target)
(should (file-directory-p target))
(copy-file
source
(expand-file-name (file-name-nondirectory source) target))
(should
(file-exists-p
(expand-file-name
(concat (file-name-nondirectory source) "/foo") target))))
(ignore-errors (delete-directory source 'recursive))
(ignore-errors (delete-directory target 'recursive))))))))
(ert-deftest tramp-test12-rename-file ()
"Check `rename-file'."
(skip-unless (tramp--test-enabled))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(dolist (source-target
`( (,tmp-name1 . ,tmp-name2)
(,tmp-name1 . ,tmp-name3)
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(unwind-protect
(progn
(should-error
(rename-file source target)
:type 'file-missing)
(write-region "foo" nil source)
(should (file-exists-p source))
(rename-file source target)
(should-not (file-exists-p source))
(should (file-exists-p target))
(with-temp-buffer
(insert-file-contents target)
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil source)
(should (file-exists-p source))
(when (tramp--test-expensive-test-p)
(should-error
(rename-file source target)
:type 'file-already-exists))
(rename-file source target 'ok)
(should-not (file-exists-p source)))
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
(unwind-protect
(progn
(write-region "foo" nil source)
(should (file-exists-p source))
(make-directory target)
(should (file-directory-p target))
(when (tramp--test-expensive-test-p)
(should-error
(rename-file source target)
:type 'file-already-exists)
(should-error
(rename-file source target 'ok)
:type 'file-error))
(rename-file source (file-name-as-directory target))
(should-not (file-exists-p source))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory source) target))))
(ignore-errors (delete-file source))
(ignore-errors (delete-directory target 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
(should (file-exists-p (expand-file-name "foo" source)))
(make-directory target)
(should (file-directory-p target))
(rename-file source (file-name-as-directory target))
(should-not (file-exists-p source))
(should
(file-exists-p
(expand-file-name
(concat (file-name-nondirectory source) "/foo") target))))
(ignore-errors (delete-directory source 'recursive))
(ignore-errors (delete-directory target 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
(should (file-exists-p (expand-file-name "foo" source)))
(make-directory target)
(should (file-directory-p target))
(rename-file
source
(expand-file-name (file-name-nondirectory source) target))
(should-not (file-exists-p source))
(should
(file-exists-p
(expand-file-name
(concat (file-name-nondirectory source) "/foo") target))))
(ignore-errors (delete-directory source 'recursive))
(ignore-errors (delete-directory target 'recursive))))))))
(ert-deftest tramp-test13-make-directory ()
"Check `make-directory'.
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo/bar" tmp-name1))
(unusual-file-mode-1 #o740)
(unusual-file-mode-2 #o710))
(unwind-protect
(progn
(with-file-modes unusual-file-mode-1
(make-directory tmp-name1))
(should-error
(make-directory tmp-name1)
:type 'file-already-exists)
(should (file-directory-p tmp-name1))
(should (file-accessible-directory-p tmp-name1))
(when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-1)
(format "%#o" (file-modes tmp-name1)))))
(should-error
(make-directory tmp-name2)
:type 'file-error)
(with-file-modes unusual-file-mode-2
(make-directory tmp-name2 'parents))
(should (file-directory-p tmp-name2))
(should (file-accessible-directory-p tmp-name2))
(when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-2)
(format "%#o" (file-modes tmp-name2)))))
(make-directory tmp-name2 'parents))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test14-delete-directory ()
"Check `delete-directory'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1)))
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(delete-directory tmp-name1)
(should-not (file-directory-p tmp-name1))
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(write-region "foo" nil (expand-file-name "bla" tmp-name1))
(should (file-exists-p (expand-file-name "bla" tmp-name1)))
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
(write-region "foo" nil (expand-file-name "bla" tmp-name2))
(should (file-exists-p (expand-file-name "bla" tmp-name2)))
(should-error
(delete-directory tmp-name1)
:type 'file-error)
(delete-directory tmp-name1 'recursive)
(should-not (file-directory-p tmp-name1))
(when (and (not (fboundp 'system-move-file-to-trash))
(not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))
(tramp--test-emacs27-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(delete-directory tmp-name1 nil 'trash)
(should-not (file-directory-p tmp-name1))
(should
(file-exists-p
(expand-file-name
(file-name-nondirectory tmp-name1) trash-directory)))
(delete-directory trash-directory 'recursive)
(should-not (file-exists-p trash-directory))
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(write-region "foo" nil (expand-file-name "bla" tmp-name1))
(should (file-exists-p (expand-file-name "bla" tmp-name1)))
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
(write-region "foo" nil (expand-file-name "bla" tmp-name2))
(should (file-exists-p (expand-file-name "bla" tmp-name2)))
(should-error
(delete-directory tmp-name1 nil 'trash)
:type (if (tramp--test-fuse-p) 'error 'file-error))
(delete-directory tmp-name1 'recursive 'trash)
(should-not (file-directory-p tmp-name1))
(should
(file-exists-p
(format
"%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1))))
(should
(file-exists-p
(format
"%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)
(file-name-nondirectory tmp-name2))))
(delete-directory trash-directory 'recursive)
(should-not (file-exists-p trash-directory)))))))
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rclone-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (expand-file-name
(file-name-nondirectory tmp-name1) tmp-name2))
(tmp-name4 (expand-file-name "foo" tmp-name1))
(tmp-name5 (expand-file-name "foo" tmp-name2))
(tmp-name6 (expand-file-name "foo" tmp-name3))
(tmp-name7 (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(should-error
(copy-directory tmp-name1 tmp-name2)
:type 'file-missing)
(make-directory tmp-name1)
(write-region "foo" nil tmp-name4)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name4))
(copy-directory tmp-name1 tmp-name2)
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
(should-error
(copy-directory tmp-name1 tmp-name2)
:type 'file-already-exists)
(copy-directory tmp-name1 (file-name-as-directory tmp-name2))
(should (file-directory-p tmp-name3))
(should (file-exists-p tmp-name6)))
(ignore-errors
(delete-directory tmp-name1 'recursive)
(delete-directory tmp-name2 'recursive)))
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name4)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name4))
(copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
(delete-file tmp-name5)
(should-not (file-exists-p tmp-name5))
(copy-directory
tmp-name1 (file-name-as-directory tmp-name2)
nil 'parents 'contents)
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
(should-not (file-directory-p tmp-name3))
(should-not (file-exists-p tmp-name6)))
(ignore-errors
(delete-directory tmp-name1 'recursive)
(delete-directory tmp-name2 'recursive)))
(when (boundp 'copy-directory-create-symlink)
(dolist (copy-directory-create-symlink '(nil t))
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(make-directory tmp-name1)
(write-region "foo" nil tmp-name4)
(make-symbolic-link tmp-name1 tmp-name7)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name4))
(should (file-symlink-p tmp-name7))
(copy-directory tmp-name7 tmp-name2)
(if copy-directory-create-symlink
(should
(string-equal
(file-symlink-p tmp-name2) (file-symlink-p tmp-name7)))
(should (file-directory-p tmp-name2)))
(delete-directory tmp-name2 'recursive)
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
(copy-directory tmp-name7 (file-name-as-directory tmp-name2))
(if copy-directory-create-symlink
(should
(string-equal
(file-symlink-p
(expand-file-name
(file-name-nondirectory tmp-name7) tmp-name2))
(file-symlink-p tmp-name7)))
(should
(file-directory-p
(expand-file-name
(file-name-nondirectory tmp-name7) tmp-name2)))))
(ignore-errors
(delete-directory tmp-name1 'recursive)
(delete-directory tmp-name2 'recursive)
(delete-directory tmp-name7 'recursive))))))))
(ert-deftest tramp-test16-directory-files ()
"Check `directory-files'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tramp-fuse-remove-hidden-files t)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "bla" tmp-name1))
(tmp-name3 (expand-file-name "foo" tmp-name1)))
(unwind-protect
(progn
(should-error
(directory-files tmp-name1)
:type 'file-missing)
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(write-region "bla" nil tmp-name3)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name2))
(should (file-exists-p tmp-name3))
(should (equal (directory-files tmp-name1) '("." ".." "bla" "foo")))
(should (equal (directory-files tmp-name1 'full)
`(,(concat tmp-name1 "/.")
,(concat tmp-name1 "/..")
,tmp-name2 ,tmp-name3)))
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
'("bla" "foo")))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
`(,tmp-name2 ,tmp-name3)))
(when (tramp--test-emacs28-p)
(with-no-warnings
(should
(equal
(directory-files
tmp-name1 nil directory-files-no-dot-files-regexp nil 1)
'("bla"))))))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test16-file-expand-wildcards ()
"Check `file-expand-wildcards'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tramp-fuse-remove-hidden-files t)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tmp-name3 (expand-file-name "bar" tmp-name1))
(tmp-name4 (expand-file-name "baz" tmp-name1))
(default-directory tmp-name1))
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(write-region "bar" nil tmp-name3)
(write-region "baz" nil tmp-name4)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name2))
(should (file-exists-p tmp-name3))
(should (file-exists-p tmp-name4))
(should
(equal (file-expand-wildcards "*")
(sort (copy-sequence '("foo" "bar" "baz")) 'string<)))
(should
(equal (file-expand-wildcards "ba?")
(sort (copy-sequence '("bar" "baz")) 'string<)))
(should
(equal (file-expand-wildcards "ba[rz]")
(sort (copy-sequence '("bar" "baz")) 'string<)))
(should
(equal
(file-expand-wildcards "*" 'full)
(sort
(copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
(should
(equal
(file-expand-wildcards "ba?" 'full)
(sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
(should
(equal
(file-expand-wildcards "ba[rz]" 'full)
(sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
(should
(equal
(file-expand-wildcards (concat tmp-name1 "/" "*"))
(sort
(copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
(should
(equal
(file-expand-wildcards (concat tmp-name1 "/" "ba?"))
(sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
(should
(equal
(file-expand-wildcards (concat tmp-name1 "/" "ba[rz]"))
(sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test17-insert-directory ()
"Check `insert-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(process-environment
(append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name2))
(with-temp-buffer
(insert-directory tmp-name1 nil)
(goto-char (point-min))
(should (looking-at-p (tramp-compat-rx (literal tmp-name1)))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) nil)
(goto-char (point-min))
(should
(looking-at-p
(tramp-compat-rx (literal (file-name-as-directory tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
(looking-at-p
(tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) "-al")
(goto-char (point-min))
(should
(looking-at-p
(tramp-compat-rx
bol (+ nonl) blank (literal tmp-name1) "/" eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
(goto-char (point-min))
(should
(looking-at-p
(rx-to-string
`(:
(? "total" (+ nonl) (+ digit) (? blank)
(? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
(= ,(length (directory-files tmp-name1))
(+ nonl) blank
(regexp ,(regexp-opt (directory-files tmp-name1)))
(? " ->" (+ nonl)) "\n"))))))
(when (and (tramp--test-supports-set-file-modes-p)
(not (tramp--test-sshfs-p))
(not (zerop (file-attribute-user-id
(file-attributes tmp-name1)))))
(set-file-modes tmp-name1 0)
(with-temp-buffer
(should-error
(insert-directory tmp-name1 nil)
:type 'file-error))
(set-file-modes tmp-name1 #o777))
(delete-directory tmp-name1 'recursive)
(with-temp-buffer
(should-error
(insert-directory tmp-name1 nil)
:type 'file-missing)))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test17-dired-with-wildcards ()
"Check `dired' with wildcards."
(skip-unless
(not (string-match-p (rx "[") ert-remote-temporary-file-directory)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name3 (expand-file-name "foo" tmp-name1))
(tmp-name4 (expand-file-name "bar" tmp-name2))
(ert-remote-temporary-file-directory
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
ert-remote-temporary-file-directory))
buffer)
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name3)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name3))
(make-directory tmp-name2)
(write-region "foo" nil tmp-name4)
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name4))
(with-current-buffer
(setq buffer
(dired-noselect
(expand-file-name
"tramp-test*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name2 ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
(with-current-buffer
(setq buffer
(dired-noselect
(expand-file-name
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
(setq tmp-name3 (expand-file-name "*?" tmp-name1))
(setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
(write-region "foo" nil tmp-name3)
(should (file-exists-p tmp-name3))
(write-region "foo" nil tmp-name4)
(should (file-exists-p tmp-name4))
(with-current-buffer
(setq buffer
(dired-noselect
(expand-file-name
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
(literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(kill-buffer buffer))
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
(ert-deftest tramp-test17-insert-directory-one-file ()
"Check `insert-directory' inside directory listing."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tmp-name3 (expand-file-name "bar" tmp-name1))
(dired-copy-preserve-time t)
(dired-recursive-copies 'top)
dired-copy-dereference
buffer)
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name2))
(with-current-buffer
(setq buffer (dired-noselect tmp-name1 "--dired -al"))
(read-only-mode -1)
(goto-char (point-min))
(while (not (or (eobp)
(string-equal
(dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name2))))
(forward-line 1))
(should-not (eobp))
(copy-file tmp-name2 tmp-name3)
(insert-directory
(file-name-nondirectory tmp-name3) "--dired -al -d")
(should
(string-equal
(dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name2)))
(should-not (search-forward "dired" nil t))
(forward-line -1)
(should
(string-equal
(dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name3))))
(kill-buffer buffer))
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `access-file', `file-readable-p',
`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((ert-remote-temporary-file-directory
(file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3
(format
"%s%s"
(file-remote-p tmp-name1)
(replace-regexp-in-string
"/" "//" (file-remote-p tmp-name1 'localname))))
(test-file-ownership-preserved-p (tramp--test-sh-p))
attr)
(unwind-protect
(progn
(when
(and test-file-ownership-preserved-p
(zerop (logand
#o1000
(file-modes ert-remote-temporary-file-directory))))
(write-region "foo" nil tmp-name1)
(setq test-file-ownership-preserved-p
(= (file-attribute-group-id (file-attributes tmp-name1))
(tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(when (tramp--test-supports-set-file-modes-p)
(write-region "foo" nil tmp-name1)
(unless
(zerop (file-attribute-user-id (file-attributes tmp-name1)))
(set-file-modes tmp-name1 0)
(should-error
(access-file tmp-name1 "error")
:type tramp-permission-denied)
(set-file-modes tmp-name1 #o777))
(delete-file tmp-name1))
(should-error
(access-file tmp-name1 "error")
:type 'file-missing)
(should-not (file-exists-p tmp-name1))
(should-not (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (consp attr))
(should (null (file-attribute-type attr)))
(should (numberp (file-attribute-link-number attr)))
(should (numberp (file-attribute-user-id attr)))
(should (numberp (file-attribute-group-id attr)))
(should
(stringp (current-time-string (file-attribute-access-time attr))))
(should
(stringp
(current-time-string (file-attribute-modification-time attr))))
(should
(stringp
(current-time-string (file-attribute-status-change-time attr))))
(should (numberp (file-attribute-size attr)))
(should (stringp (file-attribute-modes attr)))
(setq attr (file-attributes tmp-name1 'string))
(should (stringp (file-attribute-user-id attr)))
(should (stringp (file-attribute-group-id attr)))
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
:type 'file-missing)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(should-not (access-file tmp-name2 "error"))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
(with-temp-buffer
(let ((default-directory ert-remote-temporary-file-directory))
(shell-command
(format
"ln -s %s %s"
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name3))
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name2)))
t)))
(when (file-symlink-p tmp-name2)
(setq attr (file-attributes tmp-name2))
(should
(string-equal
(file-attribute-type attr)
(funcall
(if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity)
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name3)))))
(delete-file tmp-name2))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(delete-file tmp-name1)
(make-directory tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (eq (file-attribute-type attr) t)))
(ignore-errors (delete-directory tmp-name1))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
(defmacro tramp--test-deftest-with-stat (test)
"Define ert `TEST-with-stat'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) ()
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(cons '(nil "perl" nil)
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
(defmacro tramp--test-deftest-with-perl (test)
"Define ert `TEST-with-perl'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) ()
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "stat" nil)
(nil "readlink" nil)
(nil "id" nil))
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
(defmacro tramp--test-deftest-with-ls (test)
"Define ert `TEST-with-ls'."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) ()
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "perl" nil)
(nil "stat" nil)
(nil "readlink" nil))
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
(tramp--test-deftest-with-stat tramp-test18-file-attributes)
(tramp--test-deftest-with-perl tramp-test18-file-attributes)
(tramp--test-deftest-with-ls tramp-test18-file-attributes)
(defvar tramp--test-start-time nil
"Keep the start time of the current test, a float number.")
(defsubst tramp--test-file-attributes-equal-p (attr1 attr2)
"Check, whether file attributes ATTR1 and ATTR2 are equal.
They might differ only in time attributes or directory size."
(let ((attr1 (copy-sequence attr1))
(attr2 (copy-sequence attr2))
(start-time (- tramp--test-start-time 10)))
(when (eq (file-attribute-type attr1) t)
(setcar (nthcdr 1 attr1) 1))
(when (eq (file-attribute-type attr2) t)
(setcar (nthcdr 1 attr2) 1))
(setcar (nthcdr 4 attr1) tramp-time-dont-know)
(setcar (nthcdr 4 attr2) tramp-time-dont-know)
(when (or (tramp-compat-time-equal-p
(file-attribute-modification-time attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p
(file-attribute-modification-time attr2) tramp-time-dont-know))
(setcar (nthcdr 5 attr1) tramp-time-dont-know)
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
(when (< start-time
(float-time (file-attribute-modification-time attr1)))
(setcar (nthcdr 5 attr1) tramp-time-dont-know))
(when (< start-time
(float-time (file-attribute-modification-time attr2)))
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
(when (or (tramp-compat-time-equal-p
(file-attribute-status-change-time attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p
(file-attribute-status-change-time attr2) tramp-time-dont-know))
(setcar (nthcdr 6 attr1) tramp-time-dont-know)
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
(when (< start-time (float-time (file-attribute-status-change-time attr1)))
(setcar (nthcdr 6 attr1) tramp-time-dont-know))
(when (< start-time (float-time (file-attribute-status-change-time attr2)))
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
(when (eq (file-attribute-type attr1) t)
(setcar (nthcdr 7 attr1) 0))
(when (eq (file-attribute-type attr2) t)
(setcar (nthcdr 7 attr2) 0))
(unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2))
(equal attr1 attr2)))
(put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal)
(ert-deftest tramp-test19-directory-files-and-attributes ()
"Check `directory-files-and-attributes'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "bla" tmp-name1))
attr)
(unwind-protect
(progn
(should-error
(directory-files-and-attributes tmp-name1)
:type 'file-missing)
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(setq tramp--test-start-time
(float-time
(file-attribute-modification-time
(file-attributes tmp-name1))))
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
(write-region "foo" nil (expand-file-name "foo" tmp-name2))
(write-region "bar" nil (expand-file-name "bar" tmp-name2))
(write-region "boz" nil (expand-file-name "boz" tmp-name2))
(setq attr (directory-files-and-attributes tmp-name2))
(should (consp attr))
(dolist (elt attr)
(should
(tramp--test-file-attributes-equal-p
(file-attributes (expand-file-name (car elt) tmp-name2))
(cdr elt))))
(setq attr (directory-files-and-attributes tmp-name2 'full))
(should (consp attr))
(dolist (elt attr)
(should
(tramp--test-file-attributes-equal-p
(file-attributes (car elt)) (cdr elt))))
(setq attr (directory-files-and-attributes
tmp-name2 nil (rx bos "b")))
(should (equal (mapcar #'car attr) '("bar" "boz")))
(when (tramp--test-emacs28-p)
(with-no-warnings
(setq attr (directory-files-and-attributes
tmp-name2 nil (rx bos "b") nil nil 1))
(should (equal (mapcar #'car attr) '("bar"))))))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(tramp--test-deftest-with-stat tramp-test19-directory-files-and-attributes)
(tramp--test-deftest-with-perl tramp-test19-directory-files-and-attributes)
(tramp--test-deftest-with-ls tramp-test19-directory-files-and-attributes)
(ert-deftest tramp-test20-file-modes ()
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-set-file-modes-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(set-file-modes tmp-name1 #o777)
(should (= (file-modes tmp-name1) #o777))
(should (file-executable-p tmp-name1))
(should (file-writable-p tmp-name1))
(set-file-modes tmp-name1 #o444)
(should (= (file-modes tmp-name1) #o444))
(should-not (file-executable-p tmp-name1))
(unless
(or (zerop (file-attribute-user-id (file-attributes tmp-name1)))
(tramp--test-sshfs-p))
(should-not (file-writable-p tmp-name1)))
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-modes tmp-name1 #o222 'nofollow)
(should (= (file-modes tmp-name1 'nofollow) #o222))))
(should-error
(set-file-modes tmp-name2 #o777)
:type 'file-missing))
(ignore-errors (delete-file tmp-name1)))
(when (and (tramp--test-emacs28-p) (tramp--test-sh-p)
(tramp-get-remote-chmod-h tramp-test-vec))
(unwind-protect
(with-no-warnings
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(make-symbolic-link tmp-name1 tmp-name2)
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(should
(= (file-modes tmp-name1) (file-modes tmp-name2)))
(should
(= (file-modes tmp-name1) (file-modes tmp-name1 'nofollow)))
(should-not
(= (file-modes tmp-name2) (file-modes tmp-name2 'nofollow)))
(should-not
(= (file-modes tmp-name1 'nofollow)
(file-modes tmp-name2 'nofollow)))
(set-file-modes tmp-name1 #o200)
(set-file-modes tmp-name2 #o200)
(should
(= (file-modes tmp-name1) (file-modes tmp-name2) #o200))
(set-file-modes tmp-name1 #o300 'nofollow)
(set-file-modes tmp-name2 #o300 'nofollow)
(should
(= (file-modes tmp-name1 'nofollow)
(file-modes tmp-name2 'nofollow)))
(should-not (= (file-modes tmp-name1) (file-modes tmp-name2))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2)))))))
(defmacro tramp--test-ignore-add-name-to-file-error (&rest body)
"Run BODY, ignoring \"error with add-name-to-file\" file error."
(declare (indent defun) (debug (body)))
`(condition-case err
(progn ,@body)
(file-error
(unless (string-prefix-p "error with add-name-to-file"
(error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
"Check `file-symlink-p'.
This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((ert-remote-temporary-file-directory
(file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
(tmp-name4 (tramp--test-make-temp-name nil quoted))
(tmp-name5
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name4))
(tmp-name6 (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-regular-p tmp-name1))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-regular-p tmp-name2))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists))
(when (tramp--test-expensive-test-p)
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists)))
(cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2))))
(make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(make-symbolic-link
(file-remote-p tmp-name1 'localname)
tmp-name2 'ok-if-already-exists)
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
(make-directory tmp-name4)
(should (file-directory-p tmp-name4))
(should-not (file-regular-p tmp-name4))
(when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name4)
:type 'file-already-exists))
(make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name5)))
(make-symbolic-link tmp-name4 tmp-name6)
(should (file-symlink-p tmp-name6))
(should-not (file-regular-p tmp-name6))
(write-region "foo" nil (expand-file-name "foo" tmp-name6))
(delete-file (expand-file-name "foo" tmp-name6))
(should-not (file-exists-p (expand-file-name "foo" tmp-name4)))
(should-not (file-exists-p (expand-file-name "foo" tmp-name6))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-file tmp-name3))
(ignore-errors (delete-file tmp-name5))
(ignore-errors (delete-file tmp-name6))
(ignore-errors (delete-directory tmp-name4 'recursive)))
(unwind-protect
(when (tramp--test-expensive-test-p)
(tramp--test-ignore-add-name-to-file-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(add-name-to-file tmp-name1 tmp-name2)
(should (file-regular-p tmp-name2))
(should-error
(add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
(cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
(add-name-to-file tmp-name1 tmp-name2 0)
(should (file-regular-p tmp-name2)))
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
(should-not (file-symlink-p tmp-name2))
(should (file-regular-p tmp-name2))
(should-error
(add-name-to-file tmp-name1 tmp-name3)
:type 'file-error)
(make-directory tmp-name4)
(should-error
(add-name-to-file tmp-name1 tmp-name4)
:type 'file-already-exists)
(add-name-to-file tmp-name1 (file-name-as-directory tmp-name4))
(should
(file-regular-p
(expand-file-name
(file-name-nondirectory tmp-name1) tmp-name4)))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)
(delete-directory tmp-name4 'recursive)))
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-regular-p tmp-name1))
(should (string-equal tmp-name1 (file-truename tmp-name1)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name2))
(should (file-regular-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2))
(delete-file tmp-name2)
(let ((default-directory ert-remote-temporary-file-directory))
(make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
(should (file-symlink-p tmp-name2))
(should (file-regular-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2))
(let ((penguin
(if (eq tramp-syntax 'separate)
"/[penguin/motd]" "/penguin:motd:")))
(delete-file tmp-name2)
(make-symbolic-link
(funcall
(if quoted #'tramp-compat-file-name-unquote #'identity) penguin)
tmp-name2)
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name2))
(should
(string-equal
(file-truename tmp-name2)
(tramp-compat-file-name-quote
(concat (file-remote-p tmp-name2) penguin)))))
(unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3))
(should-not (file-regular-p tmp-name3))
(should-not (string-equal tmp-name3 (file-truename tmp-name3)))
(should
(string-equal
(file-truename tmp-name1)
(tramp-compat-file-name-unquote (file-truename tmp-name3))))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)
(delete-file tmp-name3)))
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(let* ((ert-remote-temporary-file-directory
(file-truename tmp-name1))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 tmp-name2)
(number-nesting 15))
(dotimes (_ number-nesting)
(make-symbolic-link
tmp-name3
(setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
(should-not (file-regular-p tmp-name2))
(should-not (file-regular-p tmp-name3))
(should
(string-equal
(file-truename tmp-name2)
(file-truename tmp-name3)))
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name2))
:type 'file-missing))
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name3))
:type 'file-missing))
(while (stringp (setq tmp-name2 (file-symlink-p tmp-name3)))
(delete-file tmp-name3)
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-file tmp-name3))
(ignore-errors (delete-directory tmp-name1 'recursive)))
(unwind-protect
(when (tramp--test-expensive-test-p)
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
(should
(string-equal
(file-truename tmp-name1)
(file-truename tmp-name2)))
(if (tramp--test-smb-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-error)
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
(should-error
(file-truename tmp-name1)
:type 'file-error)
(should-error
(file-truename tmp-name2)
:type 'file-error))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
(let* ((dir1
(directory-file-name
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
ert-remote-temporary-file-directory)))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
(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-sudoedit-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (consp (file-attribute-modification-time
(file-attributes tmp-name1))))
(skip-unless (set-file-times tmp-name1 (seconds-to-time 60)))
(unless (tramp-compat-time-equal-p
(file-attribute-modification-time
(file-attributes tmp-name1))
tramp-time-dont-know)
(should
(tramp-compat-time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 60)))
(should-error
(set-file-times tmp-name2)
:type 'file-missing)
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
(should (file-newer-than-file-p tmp-name2 tmp-name3))
(should-not (file-newer-than-file-p tmp-name3 tmp-name1))
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-times tmp-name1 (seconds-to-time 60) 'nofollow)
(should
(tramp-compat-time-equal-p
(file-attribute-modification-time
(file-attributes tmp-name1))
(seconds-to-time 60)))))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2))))))
(ert-deftest tramp-test23-visited-file-modtime ()
"Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (verify-visited-file-modtime))
(set-visited-file-modtime (seconds-to-time 1))
(should (verify-visited-file-modtime))
(should (= 1 (float-time (visited-file-modtime))))
(delete-file tmp-name)
(dired-uncache tmp-name)
(should (verify-visited-file-modtime))
(set-visited-file-modtime (seconds-to-time 1))
(should (verify-visited-file-modtime))
(should (= 1 (float-time (visited-file-modtime))))))
(ignore-errors (delete-file tmp-name))))))
(ert-deftest tramp-test24-file-acl ()
"Check that `file-acl' and `set-file-acl' work proper."
(skip-unless (tramp--test-enabled))
(skip-unless (file-acl ert-remote-temporary-file-directory))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-acl tmp-name1))
(copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
(should (file-acl tmp-name2))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
(unless (tramp--test-windows-nt-or-smb-p)
(set-file-modes tmp-name1 #o777)
(set-file-modes tmp-name2 #o444)
(should-not
(string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
(when (set-file-acl tmp-name2 (file-acl tmp-name1))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))))
(should-not (set-file-acl tmp-name2 "foo")))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2)))
(unwind-protect
(when (and (file-acl temporary-file-directory)
(not (tramp--test-windows-nt-or-smb-p)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-acl tmp-name1))
(copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions)
(should (file-acl tmp-name3))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
(set-file-modes tmp-name1 #o777)
(set-file-modes tmp-name3 #o444)
(should-not
(string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
(when (set-file-acl tmp-name3 (file-acl tmp-name1))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
(delete-file tmp-name1)
(copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions)
(should (file-acl tmp-name1))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
(set-file-modes tmp-name1 #o777)
(set-file-modes tmp-name3 #o444)
(should-not
(string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
(set-file-acl tmp-name1 (file-acl tmp-name3))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name3))))))
(ert-deftest tramp-test25-file-selinux ()
"Check `file-selinux-context' and `set-file-selinux-context'."
(skip-unless (tramp--test-enabled))
(skip-unless
(not (equal (file-selinux-context ert-remote-temporary-file-directory)
'(nil nil nil nil))))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-selinux-context tmp-name1))
(copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
(should (file-selinux-context tmp-name2))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name2)))
(let ((context (file-selinux-context tmp-name1)))
(when (and (string-equal (nth 3 context) "s0")
(setcar (nthcdr 3 context) "s0:c0")
(set-file-selinux-context tmp-name1 context))
(should-not
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name2)))))
(should
(set-file-selinux-context
tmp-name2 (file-selinux-context tmp-name1)))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name2)))
(should-not (set-file-selinux-context tmp-name2 "foo")))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2)))
(unwind-protect
(when (and (not
(or (equal (file-selinux-context temporary-file-directory)
'(nil nil nil nil))
(tramp--test-windows-nt-or-smb-p)))
(string-equal
(let ((default-directory temporary-file-directory))
(shell-command-to-string "id -Z"))
(let ((default-directory
ert-remote-temporary-file-directory))
(shell-command-to-string "id -Z"))))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-selinux-context tmp-name1))
(copy-file tmp-name1 tmp-name3)
(should (file-selinux-context tmp-name3))
(should
(set-file-selinux-context
tmp-name3 (file-selinux-context tmp-name1)))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3)))
(let ((context (file-selinux-context tmp-name1)))
(when (and (string-equal (nth 3 context) "s0")
(setcar (nthcdr 3 context) "s0:c0")
(set-file-selinux-context tmp-name1 context))
(should-not
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3)))))
(should
(set-file-selinux-context
tmp-name3 (file-selinux-context tmp-name1)))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3)))
(delete-file tmp-name1)
(copy-file tmp-name3 tmp-name1)
(should (file-selinux-context tmp-name1))
(should
(set-file-selinux-context
tmp-name1 (file-selinux-context tmp-name3)))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3)))
(let ((context (file-selinux-context tmp-name3)))
(when (and (string-equal (nth 3 context) "s0")
(setcar (nthcdr 3 context) "s0:c0")
(set-file-selinux-context tmp-name3 context))
(should-not
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3)))))
(should
(set-file-selinux-context
tmp-name1 (file-selinux-context tmp-name3)))
(should
(equal
(file-selinux-context tmp-name1)
(file-selinux-context tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name3))))))
(ert-deftest tramp-test26-file-name-completion ()
"Check `file-name-completion' and `file-name-all-completions'."
(skip-unless (tramp--test-enabled))
(unless (memq system-type '(cygwin windows-nt))
(let ((tramp-fuse-remove-hidden-files t)
(method (file-remote-p ert-remote-temporary-file-directory 'method))
(host (file-remote-p ert-remote-temporary-file-directory 'host))
(orig-syntax tramp-syntax))
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
(setq host (match-string 1 host)))
(unwind-protect
(dolist
(syntax
(if (tramp--test-expensive-test-p)
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
(tramp-set-connection-property tramp-test-vec "property" nil)
(let ((prefix-format (substring tramp-prefix-format 1))
(ipv6-prefix
(and (string-match-p tramp-ipv6-regexp host)
tramp-prefix-ipv6-format))
(ipv6-postfix
(and (string-match-p tramp-ipv6-regexp host)
tramp-postfix-ipv6-format)))
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp))
(should
(member
(concat prefix-format method tramp-postfix-method-format)
(file-name-all-completions
(concat prefix-format (substring method 0 1)) "/"))))
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp)
(tramp-string-empty-or-nil-p host)
(tramp--test-gvfs-p method))
(should
(member
(concat
prefix-format method tramp-postfix-method-format
ipv6-prefix host ipv6-postfix tramp-postfix-host-format)
(file-name-all-completions
(concat prefix-format method tramp-postfix-method-format)
"/"))))))
(tramp-change-syntax orig-syntax))))
(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
(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))
(should (file-exists-p (expand-file-name "bold" tmp-name)))
(make-directory (expand-file-name "boz" tmp-name))
(should (file-directory-p (expand-file-name "boz" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "b" tmp-name) "bo"))
(should-not (file-name-completion "a" tmp-name))
(unless (tramp--test-ange-ftp-p)
(should
(equal
(file-name-completion "b" tmp-name #'file-directory-p)
"boz/")))
(should
(equal (file-name-all-completions "fo" tmp-name) '("foo")))
(should
(equal
(sort (file-name-all-completions "b" tmp-name) #'string-lessp)
'("bold" "boz/")))
(should-not (file-name-all-completions "a" tmp-name))
(unless (tramp--test-ange-ftp-p)
(let ((completion-regexp-list
`(,directory-files-no-dot-files-regexp "b")))
(should
(equal (file-name-completion "" tmp-name) "bo"))
(should
(equal
(sort
(file-name-all-completions "" tmp-name) #'string-lessp)
'("bold" "boz/")))))
(let ((completion-ignored-extensions '(".ext")))
(write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
(should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should
(equal (file-name-completion "foo." tmp-name) "foo.ext"))
(should (equal (file-name-completion "foo.ext" tmp-name) t))
(should
(equal
(sort (file-name-all-completions "" tmp-name) #'string-lessp)
'("../" "./" "bold" "boz/" "foo" "foo.ext")))))
(ignore-errors (delete-directory tmp-name 'recursive)))))))
(ert-deftest tramp-test27-load ()
"Check `load'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(unless (tramp--test-ange-ftp-p)
(load tmp-name 'noerror 'nomessage))
(should-not (featurep 'tramp-test-load))
(write-region "(provide 'tramp-test-load)" nil tmp-name)
(when (and (tramp--test-emacs29-p)
(not (tramp--test-ange-ftp-p)))
(should-error
(load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
:type 'file-error))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
(ignore-errors
(and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
(delete-file tmp-name))))))
(defun tramp--test-shell-file-name ()
"Return default remote shell."
(if (file-exists-p
(concat
(file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh"))
"/system/bin/sh" "/bin/sh"))
(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
(fnnd (file-name-nondirectory tmp-name))
(default-directory ert-remote-temporary-file-directory)
(buffer (get-buffer-create "*tramp-tests*"))
kill-buffer-query-functions)
(unwind-protect
(progn
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
(should (= 42 (process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "exit 42")))
(unless (tramp--test-sshfs-p)
(let (process-file-return-signal-string)
(should
(= (+ 128 2)
(process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
(unless (tramp--test-sshfs-p)
(let ((process-file-return-signal-string t))
(should
(string-match-p
(rx (| "Interrupt" "Signal 2"))
(process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
(dolist (destination `(nil t ,buffer))
(when (bufferp destination)
(with-current-buffer destination
(delete-region (point-min) (point-max))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(should (zerop (process-file "ls" nil destination nil fnnd)))
(with-current-buffer
(if (bufferp destination) destination (current-buffer))
(goto-char (point-min))
(while (re-search-forward
tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (if destination (format "%s\n" fnnd) "")
(buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(goto-char (point-max)))
(should (zerop (process-file "ls" nil destination t fnnd)))
(with-current-buffer
(if (bufferp destination) destination (current-buffer))
(goto-char (point-min))
(while (re-search-forward
tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
(if destination (format "%s\n%s\n" fnnd fnnd) "")
(buffer-string))))
(unless (eq destination t)
(should (string-empty-p (buffer-string))))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))
(dolist (local '(nil t))
(with-temp-buffer
(setq tmp-name (tramp--test-make-temp-name local quoted))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(should (zerop (process-file "cat" tmp-name t)))
(should (string-equal "foo" (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))
(dolist (local '(nil t))
(setq tmp-name (tramp--test-make-temp-name local quoted))
(should-not
(zerop
(process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
(with-temp-buffer
(insert-file-contents tmp-name)
(should
(string-match-p
(rx "cat:" (* nonl) " No such file or directory")
(buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name))))
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-file tmp-name))))))
(defun tramp--test-timeout-handler (&rest _ignore)
"Timeout handler, reporting a failed test."
(interactive)
(let ((proc (get-buffer-process (current-buffer))))
(when (processp proc)
(tramp--test-message
"cmd: %s\nbuf:\n%s\n---" (process-command proc) (buffer-string))))
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions command proc)
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(apply #'start-file-process "test1" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors (delete-process proc)))
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(setq command `("cat" ,(file-name-nondirectory tmp-name))
proc
(apply #'start-file-process "test2" (current-buffer) command))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors
(delete-process proc)
(delete-file tmp-name)))
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(apply #'start-file-process "test3" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(set-process-filter
proc
(lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors (delete-process proc)))
(unless t
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(apply #'start-file-process "test4" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(set-process-filter proc t)
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
(should (= (point-min) (point-max))))
(ignore-errors (delete-process proc))))
(when (and (tramp--test-sh-p)
(not (tramp-direct-async-process-p))
(ignore-errors
(with-no-warnings
(apply #'executable-find '("hexdump" remote)))))
(dolist (process-connection-type '(nil pipe t pty))
(unwind-protect
(with-temp-buffer
(setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
proc
(apply #'start-file-process
(format "test5-%s" process-connection-type)
(current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min))
(length "66\n6F\n6F\n0D\n0A\n"))
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
(rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
(buffer-string))))
(ignore-errors (delete-process proc)))))
(unwind-protect
(with-temp-buffer
(if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
(start-file-process "test6" (current-buffer) nil)
:type 'wrong-type-argument)
(setq proc (start-file-process "test6" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should-not (process-get proc 'remote-command))
(unless (tramp--test-windows-nt-p)
(should (stringp (process-tty-name proc))))))
(ignore-errors (delete-process proc))))))
(defmacro tramp--test-deftest-direct-async-process (test &optional unstable)
"Define ert test `TEST-direct-async' for direct async processes.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
(when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and ,unstable '(:unstable)))
(skip-unless (tramp--test-enabled))
(let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(tramp-connection-properties
(cons '(nil "direct-async-process" t)
tramp-connection-properties)))
(skip-unless (tramp-direct-async-process-p))
(cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always)
((symbol-function #'internal-default-process-sentinel)
#'ignore))
(file-truename ert-remote-temporary-file-directory)
(funcall (ert-test-body ert-test)))))))
(tramp--test-deftest-direct-async-process tramp-test29-start-file-process)
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and (getenv "EMACS_EMBA_CI")
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions command proc)
(with-no-warnings (should-not (make-process)))
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(with-no-warnings
(make-process
:name "test1" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors (delete-process proc)))
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(setq command `("cat" ,(file-name-nondirectory tmp-name))
proc
(with-no-warnings
(make-process
:name "test2" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors
(delete-process proc)
(delete-file tmp-name)))
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(with-no-warnings
(make-process
:name "test3" :buffer (current-buffer) :command command
:filter
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (not (string-match-p "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
(should (string-match-p "foo" (buffer-string))))
(ignore-errors (delete-process proc)))
(unless t
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(with-no-warnings
(make-process
:name "test4" :buffer (current-buffer) :command command
:filter t
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
(should (= (point-min) (point-max))))
(ignore-errors (delete-process proc))))
(unwind-protect
(with-temp-buffer
(setq command '("cat")
proc
(with-no-warnings
(make-process
:name "test5" :buffer (current-buffer) :command command
:sentinel
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(delete-process proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(should
(string-match-p
(rx (| "unknown signal" "killed")) (buffer-string))))
(ignore-errors (delete-process proc)))
(unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p))
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
(setq command '("cat" "/does-not-exist")
proc
(with-no-warnings
(make-process
:name "test6" :buffer (current-buffer) :command command
:stderr stderr
:file-handler t)))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(with-current-buffer stderr
(with-timeout (10 (tramp--test-timeout-handler))
(while (not (string-match-p
"No such file or directory" (buffer-string)))
(while (accept-process-output
(get-buffer-process stderr) 0 nil t))))
(delete-process proc)
(should
(string-match-p
(rx "cat:" (* nonl) " No such file or directory")
(buffer-string)))))
(ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr)))))
(unless (tramp-direct-async-process-p)
(unwind-protect
(with-temp-buffer
(setq command '("cat" "/does-not-exist")
proc
(with-no-warnings
(make-process
:name "test7" :buffer (current-buffer) :command command
:stderr tmp-name
:file-handler t)))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc nil nil t)))
(delete-process proc)
(with-temp-buffer
(insert-file-contents tmp-name)
(should
(string-match-p
(rx "cat:" (* nonl) " No such file or directory")
(buffer-string)))))
(ignore-errors (delete-process proc))
(ignore-errors (delete-file tmp-name))))
(when (and (tramp--test-sh-p)
(not (tramp-direct-async-process-p))
(ignore-errors
(with-no-warnings
(apply #'executable-find '("hexdump" remote)))))
(dolist (connection-type '(nil pipe t pty))
(dolist (process-connection-type
(unless connection-type '(nil pipe t pty)))
(unwind-protect
(with-temp-buffer
(setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
proc
(with-no-warnings
(make-process
:name
(format "test8-%s-%s"
connection-type process-connection-type)
:buffer (current-buffer)
:connection-type connection-type
:command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min))
(length "66\n6F\n6F\n0D\n0A\n"))
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
(rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
(buffer-string))))
(ignore-errors (delete-process proc)))))))))
(tramp--test-deftest-direct-async-process tramp-test30-make-process)
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
:tags '(:expensive-test :tramp-asynchronous-processes :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-windows-nt-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (macrop 'with-connection-local-variables))
(let ((default-directory (file-truename ert-remote-temporary-file-directory))
(delete-exited-processes t)
kill-buffer-query-functions command proc)
(unwind-protect
(with-temp-buffer
(setq command "trap 'echo boom; exit 1' 2; sleep 100"
proc (start-file-process-shell-command
"test" (current-buffer) command))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
(should (numberp (process-get proc 'remote-pid)))
(should (equal (process-get proc 'remote-command)
(with-connection-local-variables
`(,shell-file-name ,shell-command-switch ,command))))
(should (interrupt-process proc))
(with-timeout (10 (tramp--test-timeout-handler))
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
(should-not (process-live-p proc))
(should-error
(interrupt-process proc)
:type 'error))
(ignore-errors (delete-process proc)))))
(ert-deftest tramp-test31-signal-process ()
"Check `signal-process'."
:tags '(:expensive-test :tramp-asynchronous-processes :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-windows-nt-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (macrop 'with-connection-local-variables))
(skip-unless (boundp 'signal-process-functions))
(let ((default-directory (file-truename ert-remote-temporary-file-directory))
(delete-exited-processes t)
kill-buffer-query-functions command proc)
(dolist (sigcode '(2 INT))
(unwind-protect
(with-temp-buffer
(setq command "trap 'echo boom; exit 1' 2; sleep 100"
proc (start-file-process-shell-command
(format "test1%s" sigcode) (current-buffer) command))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
(should (numberp (process-get proc 'remote-pid)))
(should (equal (process-get proc 'remote-command)
(with-connection-local-variables
`(,shell-file-name ,shell-command-switch ,command))))
(should (zerop (signal-process proc sigcode)))
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(should-not (process-live-p proc)))
(ignore-errors (kill-process proc))
(ignore-errors (delete-process proc)))
(unwind-protect
(with-temp-buffer
(setq command "trap 'echo boom; exit 1' 2; sleep 100"
proc (start-file-process-shell-command
(format "test2%s" sigcode) (current-buffer) command))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
(should (numberp (process-get proc 'remote-pid)))
(should (equal (process-get proc 'remote-command)
(with-connection-local-variables
`(,shell-file-name ,shell-command-switch ,command))))
(with-no-warnings
(should
(zerop
(signal-process
(process-get proc 'remote-pid) sigcode default-directory))))
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(should-not (process-live-p proc)))
(ignore-errors (kill-process proc))
(ignore-errors (delete-process proc))))))
(ert-deftest tramp-test31-list-system-processes ()
"Check `list-system-processes'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-emacs29-p))
(let ((default-directory ert-remote-temporary-file-directory))
(skip-unless (consp (list-system-processes)))
(should (not (equal (list-system-processes)
(let ((default-directory temporary-file-directory))
(list-system-processes)))))))
(ert-deftest tramp-test31-process-attributes ()
"Check `process-attributes'."
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-emacs29-p))
(let ((default-directory (file-truename ert-remote-temporary-file-directory))
(delete-exited-processes t)
kill-buffer-query-functions command proc)
(skip-unless (consp (list-system-processes)))
(unwind-protect
(progn
(setq command '("sleep" "100")
proc (apply #'start-file-process "test" nil command))
(while (accept-process-output proc 0))
(when-let ((pid (process-get proc 'remote-pid))
(attributes (process-attributes pid)))
(should (equal (cdr (assq 'comm attributes)) (car command)))
(should (equal (cdr (assq 'args attributes))
(mapconcat #'identity command " ")))))
(ignore-errors (delete-process proc)))))
(ert-deftest tramp-test31-memory-info ()
"Check `memory-info'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-emacs29-p))
(when-let ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(should (consp mi))
(should (tramp-compat-length= mi 4))
(dotimes (i (length mi))
(should (natnump (nth i mi))))))
(defun tramp--test-async-shell-command
(command output-buffer &optional error-buffer input)
"Like `async-shell-command', reading the output.
INPUT, if non-nil, is a string sent to the process."
(let ((proc (async-shell-command command output-buffer error-buffer))
(delete-exited-processes t))
(when (macrop 'with-connection-local-variables)
(should (equal (process-get proc 'remote-command)
(with-connection-local-variables
`(,shell-file-name ,shell-command-switch ,command)))))
(cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
(when (stringp input)
(process-send-string proc input))
(with-timeout
((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
(while
(or (accept-process-output proc nil nil t) (process-live-p proc))))
(accept-process-output proc nil nil t))))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
(with-temp-buffer
(tramp--test-async-shell-command command (current-buffer))
(buffer-substring-no-properties (point-min) (point-max))))
(ert-deftest tramp-test32-shell-command ()
"Check `shell-command'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(default-directory ert-remote-temporary-file-directory)
(inhibit-message t)
kill-buffer-query-functions)
(dolist (this-shell-command
(append
'(shell-command)
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-async-shell-command))))
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(funcall
this-shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name))
(buffer-string))))
(ignore-errors (delete-file tmp-name)))
(unless (tramp-direct-async-process-p)
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
(funcall
this-shell-command
"echo foo >&2; echo bar" (current-buffer) stderr)
(should (string-equal "bar\n" (buffer-string)))
(should
(string-equal "foo\n" (tramp-get-buffer-string stderr))))
(ignore-errors (kill-buffer stderr))))))
(when (tramp--test-asynchronous-processes-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(tramp--test-async-shell-command
"read line; ls $line" (current-buffer) nil
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
(string-match-p
(tramp-compat-rx
bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
eos)
(buffer-string))))
(ignore-errors (delete-file tmp-name))))))
(when (and (tramp--test-asynchronous-processes-p)
(tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
(default-directory ert-remote-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
"tput cols")))))
(when (natnump cols)
(should (= cols async-shell-command-width))))))
(tramp--test-deftest-direct-async-process tramp-test32-shell-command 'unstable)
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
"Check `shell-command-dont-erase-buffer'."
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless nil)
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-emacs27-p))
(let ( (inhibit-message t)
buffer kill-buffer-query-functions)
(dolist (default-directory
`(,temporary-file-directory ,ert-remote-temporary-file-directory))
(dolist (shell-command-dont-erase-buffer
'(nil erase beg-last-out end-last-out save-point random))
(dolist (current '(t nil))
(with-temp-buffer
(setq buffer (current-buffer))
(insert "foobar")
(goto-char (- (point) 3))
(should (string-equal "foobar" (buffer-string)))
(should (string-equal "foo" (buffer-substring (point-min) (point))))
(should (string-equal "bar" (buffer-substring (point) (point-max))))
(let (message-log-max)
(if current
(shell-command "echo -n bazz" (current-buffer))
(with-temp-buffer (shell-command "echo -n bazz" buffer))))
(cond
(current
(cond
((null shell-command-dont-erase-buffer)
(should (string-equal "foobazzbar" (buffer-string)))
(should (= 4 (point))))
((eq shell-command-dont-erase-buffer 'erase)
(should (string-equal "bazz" (buffer-string)))
(should (= 1 (point))))
((eq shell-command-dont-erase-buffer 'beg-last-out)
(should (string-equal "foobazzbar" (buffer-string)))
(should (= 4 (point))))
((eq shell-command-dont-erase-buffer 'save-point)
(should (string-equal "foobazzbar" (buffer-string)))
(should (= 4 (point))))
))
(t (cond
((null shell-command-dont-erase-buffer)
(should (string-equal "bazz" (buffer-string)))
(should (= 5 (point))))
((eq shell-command-dont-erase-buffer 'erase)
(should (string-equal "bazz" (buffer-string)))
(should (= 5 (point))))
((eq shell-command-dont-erase-buffer 'beg-last-out)
(should (string-equal "foobarbazz" (buffer-string)))
(should (= 7 (point))))
((eq shell-command-dont-erase-buffer 'save-point)
(should (string-equal "foobarbazz" (buffer-string)))
(should (= 4 (point))))
)))))))))
(ert-deftest tramp-test33-environment-variables ()
"Check that remote processes set / unset environment variables properly."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (this-shell-command-to-string
(append
'(shell-command-to-string)
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-shell-command-to-string-asynchronously))))
(let ((default-directory ert-remote-temporary-file-directory)
(shell-file-name "/bin/sh")
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
kill-buffer-query-functions)
(setenv "INSIDE_EMACS")
(should
(string-equal
(format "%s,tramp:%s\n" emacs-version tramp-version)
(funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))
(let ((process-environment
(cons (format "INSIDE_EMACS=%s,foo" emacs-version)
process-environment)))
(should
(string-equal
(format "%s,foo,tramp:%s\n" emacs-version tramp-version)
(funcall
this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))))
(let ((process-environment
(cons (concat envvar "=foo") process-environment)))
(should
(string-match-p
"foo"
(funcall
this-shell-command-to-string
(format "echo \"${%s:-bla}\"" envvar)))))
(let ((process-environment
(cons (concat envvar "=") process-environment)))
(should
(string-match-p
"bla"
(funcall
this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
(should
(string-match-p
(tramp-compat-rx (literal envvar))
(funcall this-shell-command-to-string "set"))))
(unless (tramp-direct-async-process-p)
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(let ((tramp-remote-process-environment
(cons (concat envvar "=foo") tramp-remote-process-environment)))
(should
(string-match-p
"foo"
(funcall
this-shell-command-to-string
(format "echo \"${%s:-bla}\"" envvar))))
(let ((process-environment (cons envvar process-environment)))
(should
(string-match-p
"bla"
(funcall
this-shell-command-to-string
(format "echo \"${%s:-bla}\"" envvar))))
(should-not
(string-match-p
(tramp-compat-rx (literal envvar))
(funcall
this-shell-command-to-string
"printenv | grep -v PS1 | grep -v _=")))))))))
(tramp--test-deftest-direct-async-process tramp-test33-environment-variables)
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
"Check that two connections with separate ports are different."
(skip-unless (tramp--test-enabled))
(skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (dir `(,ert-remote-temporary-file-directory
"/mock:localhost#11111:" "/mock:localhost#22222:"))
(tramp-cleanup-connection
(tramp-dissect-file-name dir) 'keep-debug 'keep-password))
(unwind-protect
(dolist (port '(11111 22222))
(let* ((default-directory
(format "/mock:localhost#%d:%s" port temporary-file-directory))
(shell-file-name "/bin/sh")
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
(tramp-remote-process-environment
(cons
(format "%s=%d" envvar port)
tramp-remote-process-environment)))
(should
(string-match-p
(number-to-string port)
(shell-command-to-string (format "echo $%s" envvar))))))
(dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
(tramp-cleanup-connection (tramp-dissect-file-name dir)))))
(ert-deftest tramp-test34-connection-local-variables ()
"Check that connection-local variables are enabled."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (macrop 'with-connection-local-variables))
(let* ((default-directory ert-remote-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(enable-local-variables :all)
(enable-remote-dir-locals t)
(inhibit-message t)
kill-buffer-query-functions
connection-local-profile-alist connection-local-criteria-alist)
(unwind-protect
(progn
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(with-no-warnings
(defvar-local local-variable 'buffer))
(with-temp-buffer
(should (eq local-variable 'buffer)))
(write-region "foo" nil tmp-name2)
(should (file-exists-p tmp-name2))
(connection-local-set-profile-variables
'local-variable-profile
'((local-variable . connect)))
(connection-local-set-profiles
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host))
'local-variable-profile)
(with-current-buffer (find-file-noselect tmp-name2)
(should (eq local-variable 'connect))
(kill-buffer (current-buffer)))
(write-region
"((nil . ((local-variable . dir))))" nil
(expand-file-name ".dir-locals.el" tmp-name1))
(should (file-exists-p (expand-file-name ".dir-locals.el" tmp-name1)))
(with-current-buffer (find-file-noselect tmp-name2)
(should (eq local-variable 'dir))
(kill-buffer (current-buffer)))
(write-region
"-*- mode: comint; local-variable: file; -*-" nil tmp-name2)
(should (file-exists-p tmp-name2))
(with-current-buffer (find-file-noselect tmp-name2)
(should (eq local-variable 'file))
(kill-buffer (current-buffer))))
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test34-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
(let ((default-directory ert-remote-temporary-file-directory)
explicit-shell-file-name kill-buffer-query-functions
connection-local-profile-alist connection-local-criteria-alist)
(unwind-protect
(progn
(put 'explicit-shell-file-name 'permanent-local t)
(connection-local-set-profile-variables
'remote-sh
`((explicit-shell-file-name . ,(tramp--test-shell-file-name))
(explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host))
'remote-sh)
(put 'explicit-shell-file-name 'safe-local-variable #'identity)
(put 'explicit-sh-args 'safe-local-variable #'identity)
(with-current-buffer (get-buffer-create "*shell*")
(ignore-errors (kill-process (get-buffer-process (current-buffer))))
(should-not explicit-shell-file-name)
(call-interactively #'shell)
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
(should (string-match-p (rx bol "foo" eol) (buffer-string)))))
(put 'explicit-shell-file-name 'permanent-local nil)
(kill-buffer "*shell*"))))
(ert-deftest tramp-test35-exec-path ()
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-supports-set-file-modes-p))
(skip-unless (fboundp 'exec-path))
(let ((tmp-name (tramp--test-make-temp-name))
(default-directory ert-remote-temporary-file-directory))
(unwind-protect
(progn
(should (consp (with-no-warnings (exec-path))))
(should
(string-equal
(car (last (with-no-warnings (exec-path))))
(file-remote-p default-directory 'localname)))
(should (apply #'executable-find '("sh" remote)))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(set-file-modes tmp-name #o777)
(should (file-executable-p tmp-name))
(should
(string-equal
(apply
#'executable-find `(,(file-name-nondirectory tmp-name) remote))
(file-remote-p tmp-name 'localname)))
(should-not
(apply
#'executable-find
`(,(concat (file-name-nondirectory tmp-name) "foo") remote))))
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test35-remote-path ()
"Check loooong `tramp-remote-path'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (fboundp 'exec-path))
(let* ((tmp-name (tramp--test-make-temp-name))
(default-directory ert-remote-temporary-file-directory)
(orig-exec-path (with-no-warnings (exec-path)))
(tramp-remote-path tramp-remote-path)
(orig-tramp-remote-path tramp-remote-path)
path)
(unwind-protect
(progn
(setq tramp-remote-path
(cons (file-remote-p tmp-name 'localname) tramp-remote-path))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
(setq tramp-remote-path orig-tramp-remote-path)
(setq tramp-remote-path (append '("/" "/") tramp-remote-path))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should
(equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path)))
(setq tramp-remote-path orig-tramp-remote-path)
(make-directory tmp-name)
(should (file-directory-p tmp-name))
(while (tramp-compat-length<
(mapconcat #'identity orig-exec-path ":") 5000)
(let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
(append
tramp-remote-path `(,(file-remote-p dir 'localname)))
orig-exec-path
(append
(butlast orig-exec-path)
`(,(file-remote-p dir 'localname))
(last orig-exec-path)))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
(setq path (substring (shell-command-to-string "echo $PATH") nil -1))
(unless (tramp-compat-length>
path
(tramp-get-connection-property
tramp-test-vec "pipe-buf" 4096))
(should
(string-equal
path (mapconcat #'identity (butlast orig-exec-path) ":"))))
(should (apply #'executable-find '("sh" remote))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(setq tramp-remote-path orig-tramp-remote-path)
(ignore-errors (delete-directory tmp-name 'recursive)))))
(ert-deftest tramp-test36-vc-registered ()
"Check `vc-registered'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((default-directory
(file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tramp-remote-process-environment tramp-remote-process-environment)
(inhibit-message t)
(vc-handled-backends
(cond
((tramp-find-executable
tramp-test-vec vc-git-program
(tramp-get-remote-path tramp-test-vec))
'(Git))
((tramp-find-executable
tramp-test-vec vc-hg-program
(tramp-get-remote-path tramp-test-vec))
'(Hg))
((tramp-find-executable
tramp-test-vec vc-bzr-program
(tramp-get-remote-path tramp-test-vec))
(setq tramp-remote-process-environment
(cons (format "BZR_HOME=%s"
(file-remote-p tmp-name1 'localname))
tramp-remote-process-environment))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
(t nil)))
(inhibit-message t))
(skip-unless vc-handled-backends)
(unless quoted (tramp--test-message "%s" vc-handled-backends))
(unwind-protect
(progn
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name2))
(should-not (vc-registered tmp-name1))
(should-not (vc-registered tmp-name2))
(let ((default-directory tmp-name1))
(condition-case nil
(vc-create-repo (car vc-handled-backends))
(error (ert-skip "`vc-create-repo' not supported")))
(vc-register
(list (car vc-handled-backends)
(list (file-name-nondirectory tmp-name2))))
(dired-uncache (concat (file-remote-p default-directory) "/"))
(should (vc-registered (file-name-nondirectory tmp-name2)))))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
(ert-deftest tramp-test37-make-auto-save-file-name ()
"Check `make-auto-save-file-name'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
tramp-allow-unsafe-temporary-files)
(unwind-protect
(progn
(unless (eq tramp-syntax 'separate)
(let (tramp-auto-save-directory)
(with-temp-buffer
(setq buffer-file-name tmp-name1)
(should
(string-equal
(make-auto-save-file-name)
(convert-standard-filename
(expand-file-name
(format
"#%s#"
(subst-char-in-string
?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
temporary-file-directory)))))))
(let (tramp-auto-save-directory auto-save-file-name-transforms)
(with-temp-buffer
(setq buffer-file-name tmp-name1)
(should
(string-equal
(make-auto-save-file-name)
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format "#%s#" (file-name-nondirectory tmp-name1))
ert-remote-temporary-file-directory))))))
(unless (tramp--test-ange-ftp-p)
(let ((tramp-auto-save-directory tmp-name2))
(with-temp-buffer
(setq buffer-file-name tmp-name1)
(should
(string-equal
(make-auto-save-file-name)
(expand-file-name
(format
"#%s#"
(tramp-subst-strs-in-string
'(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
(tramp-compat-file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2)))))
(unless (tramp--test-ange-ftp-p)
(let ((tramp-auto-save-directory "."))
(with-temp-buffer
(setq buffer-file-name tmp-name1
default-directory tmp-name2)
(should
(string-equal
(make-auto-save-file-name)
(expand-file-name
(format
"#%s#"
(tramp-subst-strs-in-string
'(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
(tramp-compat-file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2)))))
(let ((tramp-auto-save-directory temporary-file-directory))
(write-region "foo" nil tmp-name1)
(when (zerop (or (file-attribute-user-id
(file-attributes tmp-name1))
tramp-unknown-id-integer))
(with-temp-buffer
(setq buffer-file-name tmp-name1)
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(let ((tramp-allow-unsafe-temporary-files t))
(should (stringp (make-auto-save-file-name))))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(make-auto-save-file-name)
:type 'file-error))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p)
#'tramp--test-always))
(should (stringp (make-auto-save-file-name))))))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-directory tmp-name2 'recursive))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
(ert-deftest tramp-test38-find-backup-file-name ()
"Check `find-backup-file-name'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(ange-ftp-make-backup-files t)
tramp-allow-unsafe-temporary-files
version-control delete-old-versions
(kept-old-versions (default-toplevel-value 'kept-old-versions))
(kept-new-versions (default-toplevel-value 'kept-new-versions)))
(unwind-protect
(let (backup-directory-alist tramp-backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format "%s~" (file-name-nondirectory tmp-name1))
ert-remote-temporary-file-directory)))))))
(unwind-protect
(let ((backup-directory-alist `(("." . ,tmp-name2)))
tramp-backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format
"%s~"
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" (convert-standard-filename tmp-name1))))
tmp-name2)))))
(should (file-directory-p tmp-name2)))
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format
"%s~"
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" (convert-standard-filename tmp-name1))))
tmp-name2)))))
(should (file-directory-p tmp-name2))))
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
(unless (tramp--test-ange-ftp-p)
(let ((tramp-backup-directory-alist
`(("." . ,(file-remote-p tmp-name2 'localname))))
backup-directory-alist)
(should
(equal
(find-backup-file-name tmp-name1)
(list
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format
"%s~"
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" (convert-standard-filename tmp-name1))))
tmp-name2)))))
(should (file-directory-p tmp-name2))))
(ignore-errors (delete-directory tmp-name2 'recursive)))
(unwind-protect
(let ((backup-directory-alist `(("." . ,temporary-file-directory)))
tramp-backup-directory-alist)
(write-region "foo" nil tmp-name1)
(when (zerop (or (file-attribute-user-id (file-attributes tmp-name1))
tramp-unknown-id-integer))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(let ((tramp-allow-unsafe-temporary-files t))
(should (stringp (car (find-backup-file-name tmp-name1)))))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(find-backup-file-name tmp-name1)
:type 'file-error))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p)
#'tramp--test-always))
(should (stringp (car (find-backup-file-name tmp-name1)))))))
(ignore-errors (delete-file tmp-name1))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
(ert-deftest tramp-test39-make-lock-file-name ()
"Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file)))
(skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(remote-file-name-inhibit-cache t)
(remote-file-name-inhibit-locks nil)
(create-lockfiles t)
tramp-allow-unsafe-temporary-files
(inhibit-message t)
(tramp-fuse-unmount-on-cleanup t)
auto-save-default
noninteractive)
(unwind-protect
(progn
(should-not (with-no-warnings (file-locked-p tmp-name1)))
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
(should (buffer-modified-p))
(save-buffer)
(should-not (buffer-modified-p)))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(let ((remote-file-name-inhibit-locks t))
(with-no-warnings (lock-file tmp-name1))
(should-not (with-no-warnings (file-locked-p tmp-name1))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2))))
(should
(string-equal
(with-no-warnings (make-lock-file-name tmp-name1))
(with-no-warnings (make-lock-file-name tmp-name2))))
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-no-warnings (unlock-file tmp-name1))
(should-not (with-no-warnings (file-locked-p tmp-name1))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
(with-no-warnings (lock-file tmp-name1)))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
(with-no-warnings (lock-file tmp-name1)))
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
(with-no-warnings
(should-error
(lock-file tmp-name1)
:type 'file-locked))
(should-error
(write-region "foo" nil tmp-name1)
:type 'file-locked)
(should-error
(write-region "foo" nil tmp-name1 nil nil tmp-name1)
:type 'file-locked)
(with-temp-buffer
(should-error
(set-visited-file-name tmp-name1)
:type 'file-locked)))
(should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
(ignore-errors (delete-file tmp-name1))
(with-no-warnings (unlock-file tmp-name1))
(with-no-warnings (unlock-file tmp-name2))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
(should-not (with-no-warnings (file-locked-p tmp-name2))))
(unwind-protect
(let ((lock-file-name-transforms auto-save-file-name-transforms))
(write-region "foo" nil tmp-name1)
(when (zerop (or (file-attribute-user-id (file-attributes tmp-name1))
tramp-unknown-id-integer))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(write-region "foo" nil tmp-name1)
:type 'file-error))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p)
#'tramp--test-always))
(write-region "foo" nil tmp-name1))))
(ignore-errors (delete-file tmp-name1))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
(ert-deftest tramp-test39-detect-external-change ()
"Check that an external file modification is reported."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(dolist (create-lockfiles '(nil t))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(remote-file-name-inhibit-cache t)
(remote-file-name-inhibit-locks nil)
tramp-allow-unsafe-temporary-files
(inhibit-message t)
(tramp-fuse-unmount-on-cleanup t)
auto-save-default
(backup-inhibited t)
noninteractive)
(with-temp-buffer
(unwind-protect
(progn
(setq buffer-file-name tmp-name
buffer-file-truename tmp-name)
(insert "foo")
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (_) (ert-fail "Test failed unexpectedly"))))
(should (buffer-modified-p))
(save-buffer)
(should-not (buffer-modified-p)))
(should-not (file-locked-p tmp-name))
(set-visited-file-modtime (time-add (current-time) -60))
(when (not (verify-visited-file-modtime))
(cl-letf (((symbol-function 'read-char-choice)
(lambda (prompt &rest _) (message "%s" prompt) ?y)))
(ert-with-message-capture captured-messages
(insert "bar")
(when create-lockfiles
(should (string-match-p
(rx-to-string
`(: bol
,(if (tramp--test-crypt-p)
'(+ nonl)
(file-name-nondirectory tmp-name))
" changed on disk; really edit the buffer?"))
captured-messages))
(should (file-locked-p tmp-name)))))
(cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always)
((symbol-function 'read-char-choice)
(lambda (&rest _) ?y)))
(should (buffer-modified-p))
(save-buffer)
(should-not (buffer-modified-p)))
(should-not (file-locked-p tmp-name))))
(set-buffer-modified-p nil)
(ignore-errors (delete-file tmp-name))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)))))))
(ert-deftest tramp-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
(let ((default-directory ert-remote-temporary-file-directory)
tmp-file)
(should (stringp (temporary-file-directory)))
(should
(string-equal
(file-remote-p default-directory)
(file-remote-p (temporary-file-directory))))
(setq tmp-file (make-nearby-temp-file "tramp-test"))
(should (file-exists-p tmp-file))
(should (file-regular-p tmp-file))
(should
(string-equal
(file-remote-p default-directory)
(file-remote-p tmp-file)))
(delete-file tmp-file)
(should-not (file-exists-p tmp-file))
(setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
(should (file-exists-p tmp-file))
(should (file-directory-p tmp-file))
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
(defun tramp--test-emacs27-p ()
"Check for Emacs version >= 27.1.
Some semantics has been changed for there, without new functions
or variables, so we check the Emacs version directly."
(>= emacs-major-version 27))
(defun tramp--test-emacs28-p ()
"Check for Emacs version >= 28.1.
Some semantics has been changed for there, without new functions
or variables, so we check the Emacs version directly."
(>= emacs-major-version 28))
(defun tramp--test-emacs29-p ()
"Check for Emacs version >= 29.1.
Some semantics has been changed for there, without new functions
or variables, so we check the Emacs version directly."
(>= emacs-major-version 29))
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."
(tramp-adb-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-ange-ftp-p ()
"Check, whether Ange-FTP is used."
(eq
(tramp-find-foreign-file-name-handler tramp-test-vec)
'tramp-ftp-file-name-handler))
(defun tramp--test-asynchronous-processes-p ()
"Whether asynchronous processes tests are run.
This is used in tests which we don't want to tag
`:tramp-asynchronous-processes' completely."
(and
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:tramp-asynchronous-processes))))
(not (and (tramp--test-adb-p)
(string-match-p (tramp-compat-rx multibyte) default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is encrypted."
(tramp-crypt-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-container-p ()
"Check, whether a container method is used.
This does not support some special file names."
(string-match-p
(rx bol (| "docker" "podman") eol)
(file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
This is used in tests which we don't want to tag `:expensive'
completely."
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:expensive-test)))))
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
(string-suffix-p
"ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-fuse-p ()
"Check, whether an FUSE file system isused."
(or (tramp--test-rclone-p) (tramp--test-sshfs-p)))
(defun tramp--test-gdrive-p ()
"Check, whether the gdrive method is used."
(string-equal
"gdrive" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p (&optional method)
"Check, whether the remote host runs a GVFS based method.
This requires restrictions of file name syntax.
If optional METHOD is given, it is checked first."
(or (member method tramp-gvfs-methods)
(tramp-gvfs-file-name-p ert-remote-temporary-file-directory)))
(defun tramp--test-hpux-p ()
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
(file-truename ert-remote-temporary-file-directory)
(ignore-errors (tramp-check-remote-uname tramp-test-vec (rx bol "HP-UX"))))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
(file-truename ert-remote-temporary-file-directory)
(string-suffix-p
"ksh"
(tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-macos-p ()
"Check, whether the remote host runs macOS."
(file-truename ert-remote-temporary-file-directory)
(ignore-errors (tramp-check-remote-uname tramp-test-vec "Darwin")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
This does not support external Emacs calls."
(string-equal
"mock" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-out-of-band-p ()
"Check, whether an out-of-band method is used."
(tramp-method-out-of-band-p tramp-test-vec 1))
(defun tramp--test-rclone-p ()
"Check, whether the remote host is offered by rclone.
This requires restrictions of file name syntax."
(tramp-rclone-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
This does not support special file names."
(string-equal
"rsync" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
(tramp-sh-file-name-handler-p tramp-test-vec))
(defun tramp--test-sh-no-ls--dired-p ()
"Check, whether the remote host runs a based method from tramp-sh.el.
Additionally, ls does not support \"--dired\"."
(and (tramp--test-sh-p)
(with-temp-buffer
(ignore-errors
(insert-directory ert-remote-temporary-file-directory "-al"))
(not (tramp-get-connection-property tramp-test-vec "ls--dired")))))
(defun tramp--test-share-p ()
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
(string-match-p
(rx bol (| "afp" (: "dav" (? "s")) "smb") eol)
(file-remote-p ert-remote-temporary-file-directory 'method))))
(defun tramp--test-sshfs-p ()
"Check, whether the remote host is offered by sshfs.
This requires restrictions of file name syntax."
(tramp-sshfs-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-sudoedit-p ()
"Check, whether the sudoedit method is used."
(tramp-sudoedit-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-telnet-p ()
"Check, whether the telnet method is used.
This does not support special file names."
(string-equal
"telnet" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
(defun tramp--test-windows-nt-and-out-of-band-p ()
"Check, whether the locale host runs MS Windows and an out-of-band method.
This does not support utf8 based file transfer."
(and (tramp--test-windows-nt-p)
(tramp--test-out-of-band-p)))
(defun tramp--test-windows-nt-or-smb-p ()
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
(or (tramp--test-windows-nt-p)
(tramp--test-smb-p)))
(defun tramp--test-smb-p ()
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
(tramp-smb-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-supports-processes-p ()
"Return whether the method under test supports external processes."
(and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))
(not (tramp--test-crypt-p))))
(defun tramp--test-supports-set-file-modes-p ()
"Return whether the method under test supports setting file modes."
(or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
(and
(tramp--test-gvfs-p)
(string-suffix-p
"ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let* ((ert-remote-temporary-file-directory
(file-truename ert-remote-temporary-file-directory))
(tramp-fuse-remove-hidden-files t)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
(files
(delq
nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files)))
(process-environment process-environment)
(sorted-files (sort (copy-sequence files) #'string-lessp))
buffer)
(unwind-protect
(progn
(make-directory tmp-name1)
(make-directory tmp-name2)
(dolist (elt files)
(let* ((file1 (expand-file-name elt tmp-name1))
(file2 (expand-file-name elt tmp-name2))
(file3 (expand-file-name (concat elt "foo") tmp-name1)))
(write-region elt nil file1)
(should (file-exists-p file1))
(with-temp-buffer
(insert-file-contents file1)
(should (string-equal (buffer-string) elt)))
(copy-file file1 (file-name-as-directory tmp-name2))
(should (file-exists-p file2))
(delete-file file1)
(should-not (file-exists-p file1))
(copy-file file2 (file-name-as-directory tmp-name1))
(should (file-exists-p file1))
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link file1 file3)
(should (file-symlink-p file3))
(should
(string-equal
(expand-file-name file1) (file-truename file3)))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
(with-temp-buffer
(insert-file-contents file3)
(should (string-equal (buffer-string) elt)))
(delete-file file3))))
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
sorted-files))
(should (equal (directory-files
tmp-name2 nil directory-files-no-dot-files-regexp)
sorted-files))
(should (equal (mapcar
#'car
(directory-files-and-attributes
tmp-name1 nil directory-files-no-dot-files-regexp))
sorted-files))
(should (equal (mapcar
#'car
(directory-files-and-attributes
tmp-name2 nil directory-files-no-dot-files-regexp))
sorted-files))
(with-current-buffer
(setq buffer (dired-noselect tmp-name1 "--dired -al"))
(goto-char (point-min))
(while (not (eobp))
(when-let ((name (dired-get-filename 'no-dir 'no-error)))
(unless
(string-match-p name directory-files-no-dot-files-regexp)
(should (member name files))))
(forward-line 1)))
(kill-buffer buffer)
(dolist (elt files)
(let ((file1
(substitute-in-file-name (expand-file-name elt tmp-name1)))
(file2
(substitute-in-file-name
(expand-file-name elt tmp-name2))))
(ignore-errors (write-region elt nil file1))
(should (file-exists-p file1))
(ignore-errors (write-region elt nil file2 nil 'nomessage))
(should (file-exists-p file2))))
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
(directory-files
tmp-name2 nil directory-files-no-dot-files-regexp)))
(dolist (elt files)
(let* ((elt1 (concat elt "foo"))
(file1 (expand-file-name (concat "foo/" elt) tmp-name1))
(file2 (expand-file-name elt file1))
(file3 (expand-file-name elt1 file1)))
(make-directory file1 'parents)
(should (file-directory-p file1))
(write-region elt nil file2)
(should (file-exists-p file2))
(should
(equal
(directory-files
file1 nil directory-files-no-dot-files-regexp)
`(,elt)))
(should
(equal
(caar (directory-files-and-attributes
file1 nil directory-files-no-dot-files-regexp))
elt))
(tramp--test-ignore-make-symbolic-link-error
(unless (tramp--test-smb-p)
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
(string-equal
(caar (directory-files-and-attributes
file1 nil (tramp-compat-rx (literal elt1))))
elt1))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(cadr (car (directory-files-and-attributes
file1 nil (tramp-compat-rx (literal elt1))))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3))))
(when (and (tramp--test-expensive-test-p)
(tramp--test-supports-processes-p)
(or (and (not (tramp--test-adb-p))
(not (tramp--test-sshfs-p)))
(tramp--test-emacs27-p)))
(let ((default-directory file1))
(dolist (this-shell-command
(append
'(shell-command)
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-async-shell-command))))
(with-temp-buffer
(funcall this-shell-command "cat -- *" (current-buffer))
(should (string-equal elt (buffer-string)))))))
(delete-file file2)
(should-not (file-exists-p file2))
(delete-directory file1 'recursive)
(should-not (file-exists-p file1))))
(when (and (tramp--test-expensive-test-p) (tramp--test-sh-p)
(not (tramp--test-crypt-p))
(not (eq system-type 'darwin)))
(dolist (elt files)
(let ((envvar (concat "VAR_" (upcase (md5 elt))))
(elt (encode-coding-string elt coding-system-for-read))
(default-directory ert-remote-temporary-file-directory)
(process-environment process-environment))
(setenv envvar elt)
(setenv "PS1")
(with-temp-buffer
(should (zerop (process-file "printenv" nil t nil)))
(goto-char (point-min))
(should
(re-search-forward
(tramp-compat-rx
bol (literal envvar)
"=" (literal (getenv envvar)) eol))))))))
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) (skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-rclone-p)))
(let ((files
(list
(cond ((or (tramp--test-ange-ftp-p)
(tramp--test-container-p)
(tramp--test-gvfs-p)
(tramp--test-rclone-p)
(tramp--test-sudoedit-p)
(tramp--test-windows-nt-or-smb-p))
"foo bar baz")
((or (tramp--test-adb-p)
(eq system-type 'cygwin))
" foo bar baz ")
((tramp--test-sh-no-ls--dired-p)
"\tfoo bar baz\t")
(t " foo\tbar baz\t"))
"@foo@bar@baz@"
(unless (tramp--test-windows-nt-and-out-of-band-p) "$foo$bar$$baz$")
"-foo-bar-baz-"
(unless (tramp--test-windows-nt-and-out-of-band-p) "%foo%bar%baz%")
"&foo&bar&baz&"
(unless (or (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"?foo?bar?baz?")
(unless (or (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"*foo+bar*baz+")
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"'foo'bar'baz'"
"'foo\"bar'baz\"")
"#foo~bar#baz~"
(unless (tramp--test-windows-nt-and-out-of-band-p)
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"!foo!bar!baz!"
"!foo|bar!baz|"))
(if (or (tramp--test-gvfs-p)
(tramp--test-rclone-p)
(tramp--test-windows-nt-or-smb-p))
";foo;bar;baz;"
":foo;bar:baz;")
(unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"<foo>bar<baz>")
"(foo)bar(baz)"
(unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]")
"{foo}bar{baz}")))
(apply #'tramp--test-check-files
(if (tramp--test-expensive-test-p)
files (list (mapconcat #'identity files ""))))))
(tramp--test-deftest-with-stat tramp-test41-special-characters)
(tramp--test-deftest-with-perl tramp-test41-special-characters)
(tramp--test-deftest-with-ls tramp-test41-special-characters)
(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) (skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-gdrive-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-rclone-p)))
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
(coding-system-for-read utf8)
(coding-system-for-write utf8)
(file-name-coding-system
(coding-system-change-eol-conversion utf8 'unix)))
(apply
#'tramp--test-check-files
(append
(list
(unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
(unless (tramp--test-hpux-p)
"أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
"银河系漫游指南系列"
"Автостопом по гала́ктике"
(unless (tramp--test-adb-p) "bung")
"🌈🍒👋")
(when (tramp--test-expensive-test-p)
(delete-dups
(mapcar
(lambda (x)
(and
(not (member (car x) '("Oriya" "Odia")))
(stringp (setq x (eval (get-language-info (car x) 'sample-text) t)))
(not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
(unencodable-char-position
0 (length x) file-name-coding-system nil x)))
(setq x (mapconcat
(lambda (y)
(and (char-displayable-p y) (char-to-string y)))
x ""))
(not (string-empty-p x))
(replace-regexp-in-string (rx (any " \t\n/.?")) "" x)))
language-info-alist)))))))
(tramp--test-deftest-with-stat tramp-test42-utf8)
(tramp--test-deftest-with-perl tramp-test42-utf8)
(tramp--test-deftest-with-ls tramp-test42-utf8)
(ert-deftest tramp-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
(skip-unless (fboundp 'file-system-info))
(when-let ((fsi (with-no-warnings
(file-system-info ert-remote-temporary-file-directory))))
(should (consp fsi))
(should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
(should (natnump (or (nth i fsi) 0))))))
(defconst tramp--test-asynchronous-requests-timeout 300
"Timeout for `tramp-test44-asynchronous-requests'.")
(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
"Set \"process-name\" and \"process-buffer\" connection properties.
The values are derived from PROC. Run BODY.
This is needed in timer functions as well as process filters and sentinels."
(declare (indent 1) (debug (processp body)))
`(let* ((v (tramp-get-connection-property ,proc "vector"))
(pname (tramp-get-connection-property v "process-name"))
(pbuffer (tramp-get-connection-property v "process-buffer")))
(tramp--test-message
"tramp--test-with-proper-process-name-and-buffer before %s %s"
(tramp-get-connection-property v "process-name")
(tramp-get-connection-property v "process-buffer"))
(if (process-name ,proc)
(tramp-set-connection-property v "process-name" (process-name ,proc))
(tramp-flush-connection-property v "process-name"))
(if (process-buffer ,proc)
(tramp-set-connection-property
v "process-buffer" (process-buffer ,proc))
(tramp-flush-connection-property v "process-buffer"))
(tramp--test-message
"tramp--test-with-proper-process-name-and-buffer changed %s %s"
(tramp-get-connection-property v "process-name")
(tramp-get-connection-property v "process-buffer"))
(unwind-protect
(progn ,@body)
(if pname
(tramp-set-connection-property v "process-name" pname)
(tramp-flush-connection-property v "process-name"))
(if pbuffer
(tramp-set-connection-property v "process-buffer" pbuffer)
(tramp-flush-connection-property v "process-buffer")))))
(ert-deftest tramp-test44-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and (or (getenv "EMACS_HYDRA_CI")
(getenv "EMACS_EMBA_CI"))
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
(skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-telnet-p)))
(skip-unless (not (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-windows-nt-p)))
(with-timeout
(tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler))
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* ( (default-directory (expand-file-name temporary-file-directory))
(shell-file-name (tramp--test-shell-file-name))
(watchdog
(start-process-shell-command
"*watchdog*" nil
(format
"sleep %d; kill -USR1 %d"
tramp--test-asynchronous-requests-timeout (emacs-pid))))
(tmp-name (tramp--test-make-temp-name))
(default-directory tmp-name)
(remote-file-name-inhibit-cache t)
(process-file-side-effects t)
(inhibit-message t)
(timer-max-repeats 0)
(number-proc
(cond
((ignore-errors
(string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))))
((getenv "EMACS_HYDRA_CI") 5)
(t 10)))
(timer-repeat
(cond
((getenv "EMACS_HYDRA_CI") 10)
(t 1)))
(timer-start (current-time))
timer buffers kill-buffer-query-functions)
(unwind-protect
(progn
(make-directory tmp-name)
(setq
timer
(run-at-time
0 timer-repeat
(lambda ()
(tramp--test-with-proper-process-name-and-buffer
(get-buffer-process (tramp-get-buffer tramp-test-vec))
(when (> (- (time-to-seconds) (time-to-seconds timer-start))
tramp--test-asynchronous-requests-timeout)
(tramp--test-timeout-handler))
(when buffers
(let ((time (float-time))
(default-directory tmp-name)
(file (buffer-name (seq-random-elt buffers)))
(debug-ignored-errors
(cons 'remote-file-error debug-ignored-errors)))
(tramp--test-message
"Start timer %s %s" file (current-time-string))
(vc-registered file)
(tramp--test-message
"Stop timer %s %s" file (current-time-string))
(when (> (- (float-time) time) timer-repeat)
(setq timer-repeat (* 1.1 timer-repeat))
(setf (timer--repeat-delay timer) timer-repeat)
(tramp--test-message
"Increase timer %s" timer-repeat))))))))
(dotimes (_ number-proc)
(setq buffers (cons (generate-new-buffer "foo") buffers)))
(dolist (buf buffers)
(sit-for 0.01 'nodisp)
(let ((proc
(start-file-process-shell-command
(buffer-name buf) buf
(concat
"(read line && echo $line >$line && echo $line);"
"(read line && cat $line);"
"(read line && rm -f $line)")))
(file (expand-file-name (buffer-name buf))))
(process-put proc 'foo file)
(process-put proc 'bar 0)
(set-process-filter
proc
(lambda (proc string)
(tramp--test-with-proper-process-name-and-buffer proc
(tramp--test-message
"Process filter %s %s %s"
proc string (current-time-string))
(with-current-buffer (process-buffer proc)
(insert string))
(when (< (process-get proc 'bar) 2)
(dired-uncache (process-get proc 'foo))
(should (file-attributes (process-get proc 'foo)))))))
(set-process-sentinel
proc
(lambda (proc _state)
(tramp--test-with-proper-process-name-and-buffer proc
(tramp--test-message
"Process sentinel %s %s" proc (current-time-string)))))))
(let ((buffers (copy-sequence buffers)))
(while buffers
(let* ((buf (seq-random-elt buffers))
(proc (get-buffer-process buf))
(file (process-get proc 'foo))
(count (process-get proc 'bar)))
(tramp--test-message
"Start action %d %s %s" count buf (current-time-string))
(dired-uncache file)
(if (= count 0)
(should-not (file-attributes file))
(should (file-attributes file)))
(process-send-string proc (format "%s\n" (buffer-name buf)))
(while (accept-process-output nil 0))
(tramp--test-message
"Continue action %d %s %s" count buf (current-time-string))
(dired-uncache file)
(if (= count 2)
(should-not (file-attributes file))
(should (file-attributes file)))
(tramp--test-message
"Stop action %d %s %s" count buf (current-time-string))
(process-put proc 'bar (1+ count))
(unless (process-live-p proc)
(setq buffers (delq buf buffers))))))
(tramp--test-message "Check %s" (current-time-string))
(dolist (buf buffers)
(with-current-buffer buf
(should
(string-equal
(if (tramp--test-adb-p)
(format "%s\n%s\n%s\n%s\n%s\n" buf buf buf buf buf)
(format "%s\n%s\n" buf buf))
(buffer-string)))))
(should-not
(directory-files
tmp-name nil directory-files-no-dot-files-regexp)))
(define-key special-event-map [sigusr1] #'ignore)
(ignore-errors (quit-process watchdog))
(dolist (buf buffers)
(ignore-errors (delete-process (get-buffer-process buf)))
(ignore-errors (kill-buffer buf)))
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
(ert-deftest tramp-test45-dired-compress-file ()
"Check that Tramp (un)compresses normal files."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-emacs29-p)))
(let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name)))
(write-region "foo" nil tmp-name)
(dired default-directory)
(dired-revert)
(dired-goto-file tmp-name)
(should-not (dired-compress))
(should (string= (concat tmp-name ".gz") (dired-get-filename)))
(should-not (dired-compress))
(should (string= tmp-name (dired-get-filename)))
(delete-file tmp-name)))
(ert-deftest tramp-test45-dired-compress-dir ()
"Check that Tramp (un)compresses directories."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-emacs29-p)))
(let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name)))
(make-directory tmp-name)
(dired default-directory)
(dired-revert)
(dired-goto-file tmp-name)
(should-not (dired-compress))
(should (string= (concat tmp-name ".tar.gz") (dired-get-filename)))
(should-not (dired-compress))
(should (string= tmp-name (dired-get-filename)))
(delete-directory tmp-name)
(delete-file (concat tmp-name ".tar.gz"))))
(ert-deftest tramp-test46-read-password ()
"Check Tramp password handling."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-mock-p))
(skip-unless
(string-empty-p
(let ((shell-file-name "sh"))
(shell-command-to-string "read -s -p Password: pass"))))
(let ((pass "secret")
(mock-entry (copy-sequence (assoc "mock" tramp-methods)))
mocked-input tramp-methods)
(cl-letf* (((symbol-function #'read-string)
(lambda (&rest _args) (pop mocked-input))))
(setcdr
(assq 'tramp-login-args mock-entry)
`((("-c")
(,(tramp-shell-quote-argument
(concat
"read -s -p 'Password: ' pass; echo; "
"(test \"pass$pass\" != \"pass" pass "\" && "
"echo \"Login incorrect\" || sh -i)"))))))
(setq tramp-methods `(,mock-entry))
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(setq mocked-input `(,(copy-sequence pass)))
(should (file-exists-p ert-remote-temporary-file-directory))
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(setq mocked-input nil)
(should-error (file-exists-p ert-remote-temporary-file-directory))
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(setq mocked-input `(,(concat pass pass)))
(should-error (file-exists-p ert-remote-temporary-file-directory))
(with-no-warnings (when (symbol-plist 'ert-with-temp-file)
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(setq mocked-input nil)
(auth-source-forget-all-cached)
(ert-with-temp-file netrc-file
:prefix "tramp-test" :suffix ""
:text (format
"machine %s port mock password %s"
(file-remote-p ert-remote-temporary-file-directory 'host) pass)
(let ((auth-sources `(,netrc-file)))
(should (file-exists-p ert-remote-temporary-file-directory)))))))))
(ert-deftest tramp-test47-auto-load ()
"Check that Tramp autoloads properly."
(skip-unless (eq tramp-syntax 'default))
(skip-unless (tramp--test-enabled))
(let ((default-directory (expand-file-name temporary-file-directory))
(code
(format
"(let ((non-essential t)) \
(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
ert-remote-temporary-file-directory)))
(should
(string-match-p
(rx "Tramp loaded: t" (+ (any "\r\n")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(shell-quote-argument
(expand-file-name invocation-name invocation-directory))
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test47-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
(let ((default-directory (expand-file-name temporary-file-directory))
(code
"(progn \
(setq tramp-mode %s) \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)) \
(file-name-all-completions \"/foo:\" \"/\") \
(message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
(dolist (tm '(t nil))
(should
(string-match-p
(tramp-compat-rx
"Tramp loaded: nil" (+ (any "\r\n"))
"Tramp loaded: nil" (+ (any "\r\n"))
"Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(shell-quote-argument
(expand-file-name invocation-name invocation-directory))
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
(ert-deftest tramp-test47-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
(let ((default-directory (expand-file-name temporary-file-directory)))
(dolist (code
(list
(format
"(expand-file-name %S)" ert-remote-temporary-file-directory)
(format
"(let ((default-directory %S)) (expand-file-name %S))"
ert-remote-temporary-file-directory
temporary-file-directory)))
(should-not
(string-match-p
"Recursive load"
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(shell-quote-argument
(expand-file-name invocation-name invocation-directory))
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
(ert-deftest tramp-test47-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
(let ((default-directory (expand-file-name temporary-file-directory))
(code
"(let ((force-load-messages t) \
(load-path (cons \"/foo:bar:\" load-path))) \
(tramp-cleanup-all-connections))"))
(should
(string-match-p
(tramp-compat-rx
"Loading "
(literal
(expand-file-name
"tramp-cmds" (file-name-directory (locate-library "tramp")))))
(shell-command-to-string
(format
"%s -batch -Q -L %s -l tramp-sh --eval %s"
(shell-quote-argument
(expand-file-name invocation-name invocation-directory))
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test48-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
(require 'tramp)
(require 'tramp-archive)
(should (featurep 'tramp))
(should (featurep 'tramp-archive))
(unload-feature 'tramp 'force)
(should-not (featurep 'tramp))
(should-not (featurep 'tramp-archive))
(should-not (featurep 'tramp-theme))
(should-not
(all-completions
"tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features))))
(should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist)))
(mapatoms
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x))))
(macrop x))
(string-prefix-p "tramp" (symbol-name x))
(not (eq 'tramp-completion-mode x))
(not (eq 'tramp-register-archive-file-name-handler x))
(not (string-match-p
(rx bol "tramp" (? "-archive") (** 1 2 "-") "test")
(symbol-name x)))
(not (string-suffix-p "unload-hook" (symbol-name x)))
(not (get x 'tramp-autoload))
(ert-fail (format "`%s' still bound" x)))))
(should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
(and (functionp x) (null (autoloadp (symbol-function x)))
(string-prefix-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
(mapatoms
(lambda (x)
(and (boundp x)
(string-match-p
(rx "-" (| "hook" "function") (? "s") eol) (symbol-name x))
(not (string-suffix-p "unload-hook" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))
(mapatoms
(lambda (x)
(and (functionp x)
(advice-mapc
(lambda (fun _symbol)
(and (string-prefix-p "tramp" (symbol-name fun))
(ert-fail
(format "Function `%s' still contains Tramp advice" x))))
x))))
(require 'tramp)
(require 'tramp-archive)
(should (featurep 'tramp))
(should (featurep 'tramp-archive)))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp].
If INTERACTIVE is non-nil, the tests are run interactively."
(interactive "p")
(funcall
(if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
(rx bol "tramp")))
(provide 'tramp-tests)