mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-06 07:31:13 -08:00
More tests for Tramp
* lisp/net/tramp.el (tramp-drop-volume-letter): Handle quoted file names. * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name): Quote file name properly. * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name): Mark quoted file name as absolute. (Bug#25183) (tramp--test-windows-nt-and-batch) (tramp--test-windows-nt-and-pscp-psftp-p): New defuns. (tramp--test-windows-nt-or-smb-p): Rename from `tramp--test-smb-windows-nt-p'. Adapt callees. (tramp--test-check-files): Improve checks for environment variables. (tramp-test33-special-characters) (tramp-test33-special-characters-with-stat) (tramp-test33-special-characters-with-perl) (tramp-test33-special-characters-with-ls, tramp-test34-utf8) (tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl) (tramp-test34-utf8-with-ls): Add more checks for skip.
This commit is contained in:
Michael Albinus
parent
0390edcb81
commit
cfa2fb2626
3 changed files with 104 additions and 54 deletions
|
|
@ -5169,8 +5169,8 @@ Return ATTR."
|
|||
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
|
||||
localname)
|
||||
((not (zerop (length user)))
|
||||
(tramp-shell-quote-argument (format "%s@%s:%s" user host localname)))
|
||||
(t (tramp-shell-quote-argument (format "%s:%s" host localname))))))
|
||||
(format "%s@%s:%s" user host (shell-quote-argument localname)))
|
||||
(t (format "%s:%s" host (shell-quote-argument localname))))))
|
||||
|
||||
(defun tramp-method-out-of-band-p (vec size)
|
||||
"Return t if this is an out-of-band method, nil otherwise."
|
||||
|
|
|
|||
|
|
@ -1691,9 +1691,13 @@ locally on a remote file name. When the local system is a W32 system
|
|||
but the remote system is Unix, this introduces a superfluous drive
|
||||
letter into the file name. This function removes it."
|
||||
(save-match-data
|
||||
(if (string-match "\\`[a-zA-Z]:/" name)
|
||||
(replace-match "/" nil t name)
|
||||
name)))
|
||||
(funcall
|
||||
(if (tramp-compat-file-name-quoted-p name)
|
||||
'tramp-compat-file-name-quote 'identity)
|
||||
(let ((name (tramp-compat-file-name-unquote name)))
|
||||
(if (string-match "\\`[a-zA-Z]:/" name)
|
||||
(replace-match "/" nil t name)
|
||||
name)))))
|
||||
|
||||
;;; Config Manipulation Functions:
|
||||
|
||||
|
|
|
|||
|
|
@ -682,8 +682,8 @@ handled properly. BODY shall not contain a timeout."
|
|||
(expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file"))
|
||||
(should
|
||||
(string-equal
|
||||
(expand-file-name "/method:host:/:~/path/./file")
|
||||
"/method:host:/:~/path/file")))
|
||||
(expand-file-name "/method:host:/:/~/path/./file")
|
||||
"/method:host:/:/~/path/file")))
|
||||
|
||||
(ert-deftest tramp-test06-directory-file-name ()
|
||||
"Check `directory-file-name'.
|
||||
|
|
@ -2120,6 +2120,14 @@ This does not support globbing characters in file names (yet)."
|
|||
This requires restrictions of file name syntax."
|
||||
(tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
|
||||
|
||||
(defun tramp--test-hpux-p ()
|
||||
"Check, whether the remote host runs HP-UX.
|
||||
Several special characters do not work properly there."
|
||||
;; We must refill the cache. `file-truename' does it.
|
||||
(with-parsed-tramp-file-name
|
||||
(file-truename tramp-test-temporary-file-directory) nil
|
||||
(string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
|
||||
|
||||
(defun tramp--test-rsync-p ()
|
||||
"Check, whether the rsync method is used.
|
||||
This does not support special file names."
|
||||
|
|
@ -2132,23 +2140,28 @@ This does not support special file names."
|
|||
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
|
||||
'tramp-sh-file-name-handler))
|
||||
|
||||
(defun tramp--test-smb-or-windows-nt-p ()
|
||||
(defun tramp--test-windows-nt-and-batch ()
|
||||
"Check, whether the locale host runs MS Windows in batch mode.
|
||||
This does not support scpecial characters."
|
||||
(and (eq system-type 'windows-nt) noninteractive))
|
||||
|
||||
(defun tramp--test-windows-nt-and-pscp-psftp-p ()
|
||||
"Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
|
||||
This does not support utf8 based file transfer."
|
||||
(and (eq system-type 'windows-nt)
|
||||
(string-match
|
||||
(regexp-opt '("pscp" "psftp"))
|
||||
(file-remote-p tramp-test-temporary-file-directory 'method))))
|
||||
|
||||
(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 (eq system-type 'windows-nt)
|
||||
(tramp-smb-file-name-p tramp-test-temporary-file-directory)))
|
||||
|
||||
(defun tramp--test-hpux-p ()
|
||||
"Check, whether the remote host runs HP-UX.
|
||||
Several special characters do not work properly there."
|
||||
;; We must refill the cache. `file-truename' does it.
|
||||
(with-parsed-tramp-file-name
|
||||
(file-truename tramp-test-temporary-file-directory) nil
|
||||
(string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
|
||||
|
||||
(defun tramp--test-check-files (&rest files)
|
||||
"Run a simple but comprehensive test over every file in FILES."
|
||||
(dolist (quoted '(if tramp--test-expensive-test '(nil t) '(nil)))
|
||||
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
|
||||
;; We must use `file-truename' for the temporary directory,
|
||||
;; because it could be located on a symlinked directory. This
|
||||
;; would let the test fail.
|
||||
|
|
@ -2156,11 +2169,25 @@ Several special characters do not work properly there."
|
|||
(file-truename tramp-test-temporary-file-directory))
|
||||
(tmp-name1 (tramp--test-make-temp-name nil quoted))
|
||||
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
|
||||
(files (delq nil files)))
|
||||
(files (delq nil files))
|
||||
(process-environment process-environment))
|
||||
(unwind-protect
|
||||
(progn
|
||||
;; Add environment variables.
|
||||
(dolist (elt files)
|
||||
;; The check command (heredoc file) does not support
|
||||
;; environment variables with leading spaces.
|
||||
(let* ((elt (replace-regexp-in-string "^\\s-+" "" elt))
|
||||
(envvar (concat "VAR_" (upcase (md5 elt)))))
|
||||
(setenv envvar elt)))
|
||||
|
||||
;; We force a reconnect, in order to have a clean environment.
|
||||
(tramp-cleanup-connection
|
||||
(tramp-dissect-file-name tramp-test-temporary-file-directory)
|
||||
'keep-debug 'keep-password)
|
||||
(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))
|
||||
|
|
@ -2287,30 +2314,30 @@ Several special characters do not work properly there."
|
|||
|
||||
;; Check, that environment variables are set correctly.
|
||||
(when (and tramp--test-expensive-test (tramp--test-sh-p))
|
||||
(dolist (elt files)
|
||||
;; Tramp does not support environment variables with
|
||||
;; leading or trailing spaces. It also does not
|
||||
;; support the tab character.
|
||||
(setq elt (replace-regexp-in-string "\t" " " elt)
|
||||
elt (replace-regexp-in-string "^\\s-+\\|\\s-+$" "" elt))
|
||||
(let* ((default-directory tramp-test-temporary-file-directory)
|
||||
(shell-file-name "/bin/sh")
|
||||
(envvar
|
||||
(concat "VAR_" (upcase (md5 (current-time-string)))))
|
||||
(tramp-remote-process-environment
|
||||
(cons
|
||||
(format "%s=%s" envvar elt)
|
||||
tramp-remote-process-environment)))
|
||||
;; We force a reconnect, in order to have a clean
|
||||
;; environment.
|
||||
(tramp-cleanup-connection
|
||||
(tramp-dissect-file-name tramp-test-temporary-file-directory)
|
||||
'keep-debug 'keep-password)
|
||||
(should
|
||||
(string-equal
|
||||
elt
|
||||
(dolist (elt process-environment)
|
||||
(when (string-match "^VAR_" elt)
|
||||
(let* ((default-directory tramp-test-temporary-file-directory)
|
||||
(shell-file-name "/bin/sh")
|
||||
(heredoc (md5 (current-time-string)))
|
||||
(envvar (car (split-string elt "=" t)))
|
||||
(file1 (tramp-compat-file-name-unquote
|
||||
(expand-file-name "bar" tmp-name1))))
|
||||
;; Cleanup.
|
||||
(ignore-errors (delete-file file1))
|
||||
;; Save the variable in a file. The echo command
|
||||
;; does not work properly, it suppresses leading/
|
||||
;; trailing spaces as well as tabs.
|
||||
(shell-command-to-string
|
||||
(format "echo -n $%s" envvar))))))))
|
||||
(format
|
||||
"cat <<%s >%s\n$%s\n%s"
|
||||
heredoc (file-remote-p file1 'localname) envvar heredoc))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file1)
|
||||
(should
|
||||
(string-equal
|
||||
(buffer-string) (concat (getenv envvar) "\n"))))
|
||||
(delete-file file1)
|
||||
(should-not (file-exists-p file1)))))))
|
||||
|
||||
;; Cleanup.
|
||||
(ignore-errors (delete-directory tmp-name1 'recursive))
|
||||
|
|
@ -2324,7 +2351,7 @@ Several special characters do not work properly there."
|
|||
;; interpreted as a path separator, preventing "\t" from being
|
||||
;; expanded to <TAB>.
|
||||
(tramp--test-check-files
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
|
||||
"foo bar baz"
|
||||
(if (or (tramp--test-adb-p)
|
||||
(tramp--test-docker-p)
|
||||
|
|
@ -2337,23 +2364,23 @@ Several special characters do not work properly there."
|
|||
"&foo&bar&baz&"
|
||||
(unless (or (tramp--test-ftp-p)
|
||||
(tramp--test-gvfs-p)
|
||||
(tramp--test-smb-or-windows-nt-p))
|
||||
(tramp--test-windows-nt-or-smb-p))
|
||||
"?foo?bar?baz?")
|
||||
(unless (or (tramp--test-ftp-p)
|
||||
(tramp--test-gvfs-p)
|
||||
(tramp--test-smb-or-windows-nt-p))
|
||||
(tramp--test-windows-nt-or-smb-p))
|
||||
"*foo*bar*baz*")
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
|
||||
"'foo'bar'baz'"
|
||||
"'foo\"bar'baz\"")
|
||||
"#foo~bar#baz~"
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-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-smb-or-windows-nt-p))
|
||||
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
|
||||
";foo;bar;baz;"
|
||||
":foo;bar:baz;")
|
||||
(unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p))
|
||||
(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]")
|
||||
|
|
@ -2364,6 +2391,7 @@ Several special characters do not work properly there."
|
|||
"Check special characters in file names."
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
|
||||
(tramp--test-special-characters))
|
||||
|
||||
|
|
@ -2372,7 +2400,9 @@ Several special characters do not work properly there."
|
|||
Use the `stat' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
|
||||
(skip-unless (tramp-get-remote-stat v)))
|
||||
|
||||
|
|
@ -2388,7 +2418,9 @@ Use the `stat' command."
|
|||
Use the `perl' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
|
||||
(skip-unless (tramp-get-remote-perl v)))
|
||||
|
||||
|
|
@ -2407,7 +2439,10 @@ Use the `perl' command."
|
|||
Use the `ls' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-batch)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
|
||||
(let ((tramp-connection-properties
|
||||
(append
|
||||
|
|
@ -2441,6 +2476,8 @@ Use the `ls' command."
|
|||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (not (tramp--test-docker-p)))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-batch)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
|
||||
(tramp--test-utf8))
|
||||
|
||||
|
|
@ -2449,8 +2486,11 @@ Use the `ls' command."
|
|||
Use the `stat' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-docker-p)))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-batch)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
|
||||
(skip-unless (tramp-get-remote-stat v)))
|
||||
|
||||
|
|
@ -2466,8 +2506,11 @@ Use the `stat' command."
|
|||
Use the `perl' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-docker-p)))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-batch)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
|
||||
(skip-unless (tramp-get-remote-perl v)))
|
||||
|
||||
|
|
@ -2486,8 +2529,11 @@ Use the `perl' command."
|
|||
Use the `ls' command."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
(skip-unless (not (tramp--test-docker-p)))
|
||||
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
|
||||
(skip-unless (not (tramp--test-rsync-p)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-batch)))
|
||||
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
|
||||
|
||||
(let ((tramp-connection-properties
|
||||
(append
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue