[Emacs-diffs] master cfa2fb2: More tests for Tramp

[Michael Albinus]

branch: master
commit cfa2fb26263d741dca3c941febc0eb092a62b52e
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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.
---
 lisp/net/tramp-sh.el         |    4 +-
 lisp/net/tramp.el            |   10 ++-
 test/lisp/net/tramp-tests.el |  144 ++++++++++++++++++++++++++++--------------
 3 files changed, 104 insertions(+), 54 deletions(-)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 31ef2ef..fbf44b7 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 "address@hidden:%s" user host 
localname)))
-     (t (tramp-shell-quote-argument (format "%s:%s" host localname))))))
+      (format "address@hidden:%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 7987029..da74552 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 893dc54..ee8a95e 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 <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