From: Michael Albinus Date: Sat, 8 Nov 2014 08:46:20 +0000 (+0100) Subject: Backport Tramp changes from trunk. X-Git-Tag: emacs-24.4.90~252 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b03f9b583cf80b765cc41c095cb6c2ee04e19f40;p=emacs.git 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. --- 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 + + 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 * 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;" "bar" - "(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'.