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.
This commit is contained in:
Michael Albinus
parent
121ccd275a
commit
b03f9b583c
2 changed files with 151 additions and 52 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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'.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue