From: Michael Albinus Date: Sat, 17 Dec 2016 18:52:38 +0000 (+0100) Subject: More tests for Tramp X-Git-Tag: emacs-26.0.90~1061 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cfa2fb26263d741dca3c941febc0eb092a62b52e;p=emacs.git 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. --- diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 31ef2efbf20..fbf44b77a12 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7987029dc44..da745524a14 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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: diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 893dc543f3e..ee8a95e7bd5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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 . (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)) "bar") "(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