(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
(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))
(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."
(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))
(goto-char (point-min))
(should
(looking-at-p
- "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$"))))
+ (concat
+ ;; There might be a summary line.
+ "\\(total.+[[:digit:]]+\n\\)?"
+ ;; We don't know in which order "." and ".." appear.
+ "\\(.+ \\.?\\.\n\\)\\{2\\}"
+ ".+ foo$")))))
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test18-file-attributes ()
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)
(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
(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 ()
(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)))
"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 ()
(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))))
(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))))
(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))
(vc-create-repo (car vc-handled-backends))
;; The structure of VC-FILESET is not documented. Let's
;; hope it won't change.
- (vc-register
- nil (list (car vc-handled-backends)
- (list (file-name-nondirectory tmp-name2)))))
+ (condition-case nil
+ (vc-register
+ (list (car vc-handled-backends)
+ (list (file-name-nondirectory tmp-name2))))
+ ;; `vc-register' has changed its arguments in Emacs 25.1.
+ (error
+ (vc-register
+ nil (list (car vc-handled-backends)
+ (list (file-name-nondirectory tmp-name2)))))))
(should (vc-registered tmp-name2)))
(ignore-errors (delete-directory tmp-name1 'recursive)))))
+(defun tramp--test-smb-or-windows-nt-p ()
+ "Check, whether the locale or remote host runs MS Windows.
+This requires restrictions of file name syntax."
+ (or (eq system-type 'windows-nt)
+ (eq (tramp-find-foreign-file-name-handler
+ tramp-test-temporary-file-directory)
+ 'tramp-smb-file-name-handler)))
+
(defun tramp--test-check-files (&rest files)
"Runs a simple but comprehensive test over every file in FILES."
(let ((tmp-name1 (tramp--test-make-temp-name))
(progn
(make-directory tmp-name1)
(make-directory tmp-name2)
- (dolist (elt files)
+ (dolist (elt (delq nil files))
(let ((file1 (expand-file-name elt tmp-name1))
(file2 (expand-file-name elt tmp-name2)))
(write-region elt nil file1)
(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)))))
(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))))
;; Newlines, slashes and backslashes in file names are not supported.
;; So we don't test.
(tramp--test-check-files
- " foo\tbar baz\t"
+ (if (tramp--test-smb-or-windows-nt-p) "foo bar baz" " foo\tbar baz\t")
"$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)"))
+ (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?")
+ (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*")
+ (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"")
+ "#foo~bar#baz~"
+ (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|")
+ (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;")
+ (unless (tramp--test-smb-or-windows-nt-p) "<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."
;; * set-file-acl
;; * set-file-selinux-context
-;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
-;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
-;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when
-;; target is a dumb busybox). Seems to be in `directory-files'.
+;; * 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-test30-special-characters' for `adb' and `nc'.
+;; * Fix `tramp-test31-utf8' for `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'.
;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
;; expected error.