Backport Tramp changes from trunk.

* automated/tramp-tests.el (tramp-remote-process-environment):
Declare.
(tramp--test-enabled): Ignore errors.
(tramp--instrument-test-case): Extend docstring.  Print debug
buffer in any case.
(tramp-test15-copy-directory): Skip for tramp-smb.el.
(tramp-test21-file-links): Use `file-truename' for directories.
(tramp-test26-process-file): Extend test according to Bug#17815.
(tramp-test27-start-file-process, tramp-test28-shell-command):
Retrieve process output more robustly.
(tramp-test29-vc-registered): Set $BZR_HOME.
(tramp--test-check-files): Extend test with `substitute-in-file-name'.
(tramp-test30-special-characters): Skip for tramp-adb.el,
tramp-gvfs.el and tramp-smb.el.  Add further file names.

2 files changed, 151 insertions, 52 deletions

diff --git a/test/ChangeLog b/test/ChangeLog
index c1c2f5c870b..a5ee4b60589 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,22 @@
+2014-11-08  Michael Albinus  <michael.albinus@gmx.de>
+
+        Backport Tramp changes from trunk.
+
+        * automated/tramp-tests.el (tramp-remote-process-environment):
+        Declare.
+        (tramp--test-enabled): Ignore errors.
+        (tramp--instrument-test-case): Extend docstring.  Print debug
+        buffer in any case.
+        (tramp-test15-copy-directory): Skip for tramp-smb.el.
+        (tramp-test21-file-links): Use `file-truename' for directories.
+        (tramp-test26-process-file): Extend test according to Bug#17815.
+        (tramp-test27-start-file-process, tramp-test28-shell-command):
+        Retrieve process output more robustly.
+        (tramp-test29-vc-registered): Set $BZR_HOME.
+        (tramp--test-check-files): Extend test with `substitute-in-file-name'.
+        (tramp-test30-special-characters): Skip for tramp-adb.el,
+        tramp-gvfs.el and tramp-smb.el.  Add further file names.
+
 2014-10-20  Glenn Morris  <rgm@gnu.org>
 
         * Version 24.4 released.
diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el
index 2640ee9cef5..864a43d638f 100644
--- a/test/automated/tramp-tests.el
+++ b/test/automated/tramp-tests.el
@@ -47,6 +47,7 @@
 (declare-function tramp-find-executable "tramp-sh")
 (declare-function tramp-get-remote-path "tramp-sh")
 (defvar tramp-copy-size-limit)
+(defvar tramp-remote-process-environment)
 
 ;; There is no default value on w32 systems, which could work out of the box.
 (defconst tramp-test-temporary-file-directory
@@ -92,9 +93,10 @@ being the result.")
 
   (when (cdr tramp--test-enabled-checked)
     ;; Cleanup connection.
-    (tramp-cleanup-connection
-     (tramp-dissect-file-name tramp-test-temporary-file-directory)
-     nil 'keep-password))
+    (ignore-errors
+      (tramp-cleanup-connection
+       (tramp-dissect-file-name tramp-test-temporary-file-directory)
+       nil 'keep-password)))
 
   ;; Return result.
   (cdr tramp--test-enabled-checked))
@@ -108,27 +110,21 @@ being the result.")
 (defmacro tramp--instrument-test-case (verbose &rest body)
   "Run BODY with `tramp-verbose' equal VERBOSE.
 Print the the content of the Tramp debug buffer, if BODY does not
-eval properly in `should', `should-not' or `should-error'."
+eval properly in `should', `should-not' or `should-error'.  BODY
+shall not contain a timeout."
   (declare (indent 1) (debug (natnump body)))
   `(let ((tramp-verbose ,verbose)
          (tramp-message-show-message t)
          (tramp-debug-on-error t))
-     (condition-case err
-         ;; In general, we cannot use a timeout here: this would
-         ;; prevent traces when the test runs into an error.
-;        (with-timeout (10 (ert-fail "`tramp--instrument-test-case' timed out"))
-         (progn
-           ,@body)
-       (ert-test-skipped
-        (signal (car err) (cdr err)))
-       ((error quit)
-        (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
-          (with-current-buffer (tramp-get-connection-buffer v)
-            (message "%s" (buffer-string)))
-          (with-current-buffer (tramp-get-debug-buffer v)
-            (message "%s" (buffer-string))))
-        (message "%s" err)
-        (signal (car err) (cdr err))))))
+     (unwind-protect
+         (progn ,@body)
+       (when (> tramp-verbose 3)
+         (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+           (with-current-buffer (tramp-get-connection-buffer v)
+             (message "%s" (buffer-string)))
+           (with-current-buffer
+               (tramp-get-debug-buffer v)
+             (message "%s" (buffer-string))))))))
 
 (ert-deftest tramp-test00-availability ()
   "Test availability of Tramp functions."
@@ -867,6 +863,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
 (ert-deftest tramp-test15-copy-directory ()
   "Check `copy-directory'."
   (skip-unless (tramp--test-enabled))
+  (skip-unless
+   (not
+    (eq
+     (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+     'tramp-smb-file-name-handler)))
 
   (let* ((tmp-name1 (tramp--test-make-temp-name))
          (tmp-name2 (tramp--test-make-temp-name))
@@ -1073,9 +1074,14 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
 This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   (skip-unless (tramp--test-enabled))
 
-  (let ((tmp-name1 (tramp--test-make-temp-name))
-        (tmp-name2 (tramp--test-make-temp-name))
-        (tmp-name3 (tramp--test-make-temp-name 'local)))
+  ;; We must use `file-truename' for the temporary directory, because
+  ;; it could be located on a symlinked directory.  This would let the
+  ;; test fail.
+  (let* ((tramp-test-temporary-file-directory
+          (file-truename tramp-test-temporary-file-directory))
+         (tmp-name1 (tramp--test-make-temp-name))
+         (tmp-name2 (tramp--test-make-temp-name))
+         (tmp-name3 (tramp--test-make-temp-name 'local)))
     (unwind-protect
         (progn
           (write-region "foo" nil tmp-name1)
@@ -1237,9 +1243,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
      (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
      '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
 
-  (let ((tmp-name (tramp--test-make-temp-name))
-        (default-directory tramp-test-temporary-file-directory)
-        kill-buffer-query-functions)
+  (let* ((tmp-name (tramp--test-make-temp-name))
+         (fnnd (file-name-nondirectory tmp-name))
+         (default-directory tramp-test-temporary-file-directory)
+         kill-buffer-query-functions)
     (unwind-protect
         (progn
           ;; We cannot use "/bin/true" and "/bin/false"; those paths
@@ -1250,17 +1257,25 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
           (with-temp-buffer
             (write-region "foo" nil tmp-name)
             (should (file-exists-p tmp-name))
-            (should
-             (zerop
-              (process-file "ls" nil t nil (file-name-nondirectory tmp-name))))
+            (should (zerop (process-file "ls" nil t nil fnnd)))
+            ;; `ls' could produce colorized output.
+            (goto-char (point-min))
+            (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+              (replace-match "" nil nil))
+            (should (string-equal (format "%s\n" fnnd) (buffer-string)))
+            (should-not (get-buffer-window (current-buffer) t))
+
+            ;; Second run. The output must be appended.
+            (should (zerop (process-file "ls" nil t t fnnd)))
             ;; `ls' could produce colorized output.
             (goto-char (point-min))
             (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
               (replace-match "" nil nil))
             (should
-             (string-equal
-              (format "%s\n" (file-name-nondirectory tmp-name))
-              (buffer-string)))))
+             (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
+            ;; A non-nil DISPLAY must not raise the buffer.
+            (should-not (get-buffer-window (current-buffer) t))))
+
       (ignore-errors (delete-file tmp-name)))))
 
 (ert-deftest tramp-test27-start-file-process ()
@@ -1284,7 +1299,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
           (should (equal (process-status proc) 'run))
           (process-send-string proc "foo")
           (process-send-eof proc)
-          (accept-process-output proc 1)
+          ;; Read output.
+          (with-timeout (10 (ert-fail "`start-file-process' timed out"))
+            (while (< (- (point-max) (point-min)) (length "foo"))
+              (accept-process-output proc 1)))
           (should (string-equal (buffer-string) "foo")))
       (ignore-errors (delete-process proc)))
 
@@ -1297,22 +1315,30 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                  "test2" (current-buffer)
                  "cat" (file-name-nondirectory tmp-name)))
           (should (processp proc))
-          (accept-process-output proc 1)
+          ;; Read output.
+          (with-timeout (10 (ert-fail "`start-file-process' timed out"))
+            (while (< (- (point-max) (point-min)) (length "foo"))
+              (accept-process-output proc 1)))
           (should (string-equal (buffer-string) "foo")))
       (ignore-errors
         (delete-process proc)
         (delete-file tmp-name)))
 
     (unwind-protect
-        (progn
-          (setq proc (start-file-process "test3" nil "cat"))
+        (with-temp-buffer
+          (setq proc (start-file-process "test3" (current-buffer) "cat"))
           (should (processp proc))
           (should (equal (process-status proc) 'run))
           (set-process-filter
-           proc (lambda (_p s) (should (string-equal s "foo"))))
+           proc
+           (lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
           (process-send-string proc "foo")
           (process-send-eof proc)
-          (accept-process-output proc 1))
+          ;; Read output.
+          (with-timeout (10 (ert-fail "`start-file-process' timed out"))
+            (while (< (- (point-max) (point-min)) (length "foo"))
+              (accept-process-output proc 1)))
+          (should (string-equal (buffer-string) "foo")))
       (ignore-errors (delete-process proc)))))
 
 (ert-deftest tramp-test28-shell-command ()
@@ -1350,17 +1376,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
           (should (file-exists-p tmp-name))
           (async-shell-command
            (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
-          (accept-process-output (get-buffer-process (current-buffer)) 1)
+          (set-process-sentinel (get-buffer-process (current-buffer)) nil)
+          ;; Read output.
           (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
-            (while
-                (ignore-errors
-                  (memq (process-status (get-buffer-process (current-buffer)))
-                        '(run open)))
+            (while (< (- (point-max) (point-min))
+                      (1+ (length (file-name-nondirectory tmp-name))))
               (accept-process-output (get-buffer-process (current-buffer)) 1)))
           ;; `ls' could produce colorized output.
           (goto-char (point-min))
           (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
             (replace-match "" nil nil))
+          ;; There might be a nasty "Process *Async Shell* finished" message.
+          (goto-char (point-min))
+          (forward-line)
+          (narrow-to-region (point-min) (point))
           (should
            (string-equal
             (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
@@ -1371,16 +1400,23 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
           (write-region "foo" nil tmp-name)
           (should (file-exists-p tmp-name))
           (async-shell-command "read line; ls $line" (current-buffer))
+          (set-process-sentinel (get-buffer-process (current-buffer)) nil)
           (process-send-string
            (get-buffer-process (current-buffer))
            (format "%s\n" (file-name-nondirectory tmp-name)))
-          (accept-process-output (get-buffer-process (current-buffer)) 1)
+          ;; Read output.
           (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
-            (while
-                (ignore-errors
-                  (memq (process-status (get-buffer-process (current-buffer)))
-                        '(run open)))
+            (while (< (- (point-max) (point-min))
+                      (1+ (length (file-name-nondirectory tmp-name))))
               (accept-process-output (get-buffer-process (current-buffer)) 1)))
+          ;; `ls' could produce colorized output.
+          (goto-char (point-min))
+          (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+            (replace-match "" nil nil))
+          ;; There might be a nasty "Process *Async Shell* finished" message.
+          (goto-char (point-min))
+          (forward-line)
+          (narrow-to-region (point-min) (point))
           (should
            (string-equal
             (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
@@ -1397,10 +1433,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   (let* ((default-directory tramp-test-temporary-file-directory)
          (tmp-name1 (tramp--test-make-temp-name))
          (tmp-name2 (expand-file-name "foo" tmp-name1))
+         (tramp-remote-process-environment tramp-remote-process-environment)
          (vc-handled-backends
           (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
             (cond
              ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v))
+              (setq tramp-remote-process-environment
+                    (cons (format "BZR_HOME=%s"
+                                  (file-remote-p tmp-name1 'localname))
+                          tramp-remote-process-environment))
+              ;; We must force a reconnect, in order to activate $BZR_HOME.
+              (tramp-cleanup-connection
+               (tramp-dissect-file-name tramp-test-temporary-file-directory)
+               nil 'keep-password)
               '(Bzr))
              ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
               '(Git))
@@ -1455,13 +1500,34 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
               (should-not (file-exists-p file1))
               (copy-file file2 tmp-name1)
               (should (file-exists-p file1))))
+
           ;; Check file names.
           (should (equal (directory-files
                           tmp-name1 nil directory-files-no-dot-files-regexp)
                          (sort (copy-sequence files) 'string-lessp)))
           (should (equal (directory-files
                           tmp-name2 nil directory-files-no-dot-files-regexp)
-                         (sort files 'string-lessp))))
+                         (sort (copy-sequence files) 'string-lessp)))
+
+          ;; `substitute-in-file-name' could return different values.
+          ;; For `adb', there could be strange file permissions
+          ;; preventing overwriting a file.  We don't care in this
+          ;; testcase.
+          (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))))
+
       (ignore-errors (delete-directory tmp-name1 'recursive))
       (ignore-errors (delete-directory tmp-name2 'recursive)))))
 
@@ -1469,6 +1535,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 (ert-deftest tramp-test30-special-characters ()
   "Check special characters in file names."
   (skip-unless (tramp--test-enabled))
+  (skip-unless
+   (not
+    (memq
+     (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+     '(tramp-adb-file-name-handler
+       tramp-gvfs-file-name-handler
+       tramp-smb-file-name-handler))))
 
   ;; Newlines, slashes and backslashes in file names are not supported.
   ;; So we don't test.
@@ -1481,11 +1554,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
    "?foo?bar?baz?"
    "*foo*bar*baz*"
    "'foo\"bar'baz\""
-   "#foo#bar#baz#"
+   "#foo~bar#baz~"
    "!foo|bar!baz|"
    ":foo;bar:baz;"
    "<foo>bar<baz>"
-   "(foo)bar(baz)"))
+   "(foo)bar(baz)"
+   "[foo]bar[baz]"
+   "{foo}bar{baz}"))
 
 (ert-deftest tramp-test31-utf8 ()
   "Check UTF8 encoding in file names and file contents."
@@ -1657,8 +1732,13 @@ Since it unloads Tramp, it shall be the last test to run."
 ;; * set-file-acl
 ;; * set-file-selinux-context
 
-;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
+;; * Work on skipped tests.  Make a comment, when it is impossible.
+;; * Fix `tramp-test15-copy-directory' for `smb'.  Using tar in a pipe
+;;   doesn't work well when an interactive password must be provided.
+;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
+;;   Windows (`process-send-eof'?).
 ;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
+;; * Fix `tramp-test30-special-characters' for `adb', `nc' and `smb'.
 ;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when
 ;;   target is a dumb busybox).  Seems to be in `directory-files'.
 ;; * Fix Bug#16928.  Set expected error of `tramp-test32-asynchronous-requests'.