Commit cfa2fb26 authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent 0390edcb
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment