[Emacs-diffs] emacs-24 r117685: Backport Tramp changes from trunk.

[Michael Albinus]

------------------------------------------------------------
revno: 117685
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: emacs-24
timestamp: Sat 2014-11-08 09:46:20 +0100
message:
  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.
modified:
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/tramp-tests.el  tramptests.el-20131105142319-d9zp3oprkpxj5v1e-1

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-10-20 19:21:15 +0000
+++ b/test/ChangeLog    2014-11-08 08:46:20 +0000
@@ -1,3 +1,22 @@
+2014-11-08  Michael Albinus  <address@hidden>
+
+       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  <address@hidden>
 
        * Version 24.4 released.

=== modified file 'test/automated/tramp-tests.el'
--- a/test/automated/tramp-tests.el     2014-06-01 10:38:09 +0000
+++ b/test/automated/tramp-tests.el     2014-11-08 08:46:20 +0000
@@ -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 @@
 
   (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 @@
 (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 @@
 (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 `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 @@
      (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 @@
          (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))))
-           ;; `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)))))
+           (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%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 @@
          (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 @@
                 "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 @@
          (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 @@
           (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 @@
   (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 @@
              (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 @@
 (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 @@
    "?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 @@
 ;; * 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'.