;;; tramp-tests.el --- Tests of remote file access
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; The tests require a recent ert.el from Emacs 24.4.
;; Some of the tests require access to a remote host files. Set
-;; $TRAMP_TEST_TEMPORARY_FILE_DIRECTORY to a suitable value in order
+;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order
;; to overwrite the default value. If you want to skip tests
;; accessing a remote host, set this environment variable to
;; "/dev/null" or whatever is appropriate on your system.
;; When running the tests in batch mode, it must NOT require an
;; interactive password prompt unless the environment variable
-;; $TRAMP_TEST_ALLOW_PASSWORD is set.
+;; $REMOTE_ALLOW_PASSWORD is set.
;; A whole test run can be performed calling the command `tramp-test-all'.
(require 'ert)
(require 'tramp)
+(require 'vc)
+(require 'vc-bzr)
+(require 'vc-git)
+(require 'vc-hg)
+
+(declare-function tramp-find-executable "tramp-sh")
+(declare-function tramp-get-remote-path "tramp-sh")
;; There is no default value on w32 systems, which could work out of the box.
(defconst tramp-test-temporary-file-directory
(cond
- ((getenv "TRAMP_TEST_TEMPORARY_FILE_DIRECTORY"))
+ ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
((eq system-type 'windows-nt) null-device)
(t (format "/ssh::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
-(setq tramp-verbose 0
+(setq password-cache-expiry nil
+ tramp-verbose 0
tramp-message-show-message nil)
;; Disable interactive passwords in batch mode.
-(when (and noninteractive (not (getenv "TRAMP_TEST_ALLOW_PASSWORD")))
+(when (and noninteractive (not (getenv "REMOTE_ALLOW_PASSWORD")))
(defalias 'tramp-read-passwd 'ignore))
;; This shall happen on hydra only.
(file-remote-p tramp-test-temporary-file-directory)
(file-directory-p tramp-test-temporary-file-directory)
(file-writable-p tramp-test-temporary-file-directory))))))
+
+ (when (and (cdr tramp--test-enabled-checked)
+ (not (eq (tramp-find-foreign-file-name-handler
+ tramp-test-temporary-file-directory)
+ 'tramp-adb-file-name-handler)))
+ ;; Cleanup connection. We don't cleanup for adb, because it
+ ;; doesn't behave well when is disconnect several times.
+ (tramp-cleanup-connection
+ (tramp-dissect-file-name tramp-test-temporary-file-directory)
+ nil 'keep-password))
+
;; Return result.
(cdr tramp--test-enabled-checked))
(expand-file-name
(make-temp-name "tramp-test") tramp-test-temporary-file-directory))
+(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'."
+ (declare (indent 1) (debug (natnump body)))
+ `(let ((tramp-verbose ,verbose)
+ (tramp-debug-on-error t))
+ (condition-case err
+ (progn ,@body)
+ (ert-test-skipped
+ (signal (car err) (cdr err)))
+ (error
+ (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))))))
+
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
(should (string-equal
(file-remote-p "/method:user@1.2.3.4:" 'localname) ""))
- ;; This does not work. Why?
- ;(should (file-remote-p "/[]:"))
+ ;; Expand `tramp-default-method', `tramp-default-user' and
+ ;; `tramp-default-host'.
+ (should (string-equal
+ (file-remote-p "/[]:")
+ (format
+ "/%s:%s@%s:" "default-method" "default-user" "default-host")))
+ (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
+ (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
+ (should (string-equal (file-remote-p "/[]:" 'host) "default-host"))
+ (should (string-equal (file-remote-p "/[]:" 'localname) ""))
+
+ ;; Expand `tramp-default-method' and `tramp-default-user'.
+ (let ((tramp-default-host "::1"))
+ (should (string-equal
+ (file-remote-p "/[]:")
+ (format "/%s:%s@%s:" "default-method" "default-user" "[::1]")))
+ (should (string-equal (file-remote-p "/[]:" 'method) "default-method"))
+ (should (string-equal (file-remote-p "/[]:" 'user) "default-user"))
+ (should (string-equal (file-remote-p "/[]:" 'host) "::1"))
+ (should (string-equal (file-remote-p "/[]:" 'localname) "")))
;; Expand `tramp-default-method' and `tramp-default-user'.
(should (string-equal
(dolist (u '("ftp" "anonymous"))
(should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp")))
;; Default values in tramp-gvfs.el.
- ;(should (string-equal (file-remote-p "/synce::" 'user) nil))
+ (when (and (load "tramp-gvfs" 'noerror 'nomessage)
+ (symbol-value 'tramp-gvfs-enabled))
+ (should (string-equal (file-remote-p "/synce::" 'user) nil)))
;; Default values in tramp-gw.el.
(dolist (m '("tunnel" "socks"))
- (should (string-equal (file-remote-p (format "/%s::" m) 'user)
- (user-login-name))))
+ (should
+ (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
;; Default values in tramp-sh.el.
(dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name)))
(should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su")))
(dolist (m '("su" "sudo" "ksu"))
(should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")))
(dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
- (should (string-equal (file-remote-p (format "/%s::" m) 'user)
- (user-login-name))))
+ (should
+ (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name))))
;; Default values in tramp-smb.el.
(should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb"))
(should (string-equal (file-remote-p "/smb::" 'user) nil)))
(ert-deftest tramp-test04-substitute-in-file-name ()
"Check `substitute-in-file-name'."
(should (string-equal (substitute-in-file-name "/method:host://foo") "/foo"))
- (should (string-equal
- (substitute-in-file-name "/method:host:/path//foo")
- "/method:host:/foo"))
- (should (string-equal
- (substitute-in-file-name "/method:host:/path///foo") "/foo"))
- (should (string-equal
- (substitute-in-file-name "/method:host:/path/~/foo")
- "/method:host:~/foo"))
- (should (string-equal
- (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo"))
+ (should
+ (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo"))
+ (should
+ (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo"))
(let (process-environment)
(should
- (string-equal (substitute-in-file-name "/method:host:/path/$FOO")
- "/method:host:/path/$FOO"))
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$FOO")
+ "/method:host:/path/$FOO"))
(setenv "FOO" "bla")
- (should (string-equal
- (substitute-in-file-name "/method:host:/path/$FOO")
- "/method:host:/path/bla"))
- (should (string-equal
- (substitute-in-file-name "/method:host:/path/$$FOO")
- "/method:host:/path/$FOO"))))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$FOO")
+ "/method:host:/path/bla"))
+ (should
+ (string-equal
+ (substitute-in-file-name "/method:host:/path/$$FOO")
+ "/method:host:/path/$FOO"))))
(ert-deftest tramp-test05-expand-file-name ()
"Check `expand-file-name'."
- (should (string-equal
- (expand-file-name "/method:host:/path/./file")
- "/method:host:/path/file"))
- (should (string-equal
- (expand-file-name "/method:host:/path/../file")
- "/method:host:/file")))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/./file") "/method:host:/path/file"))
+ (should
+ (string-equal
+ (expand-file-name "/method:host:/path/../file") "/method:host:/file")))
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory'
and `file-name-nondirectory'."
- (should (string-equal
- (directory-file-name "/method:host:/path/to/file")
- "/method:host:/path/to/file"))
- (should (string-equal
- (directory-file-name "/method:host:/path/to/file/")
- "/method:host:/path/to/file"))
- (should (string-equal
- (file-name-as-directory "/method:host:/path/to/file")
- "/method:host:/path/to/file/"))
- (should (string-equal
- (file-name-as-directory "/method:host:/path/to/file/")
- "/method:host:/path/to/file/"))
- (should (string-equal
- (file-name-directory "/method:host:/path/to/file")
- "/method:host:/path/to/"))
- (should (string-equal
- (file-name-directory "/method:host:/path/to/file/")
- "/method:host:/path/to/file/"))
- (should (string-equal
- (file-name-nondirectory "/method:host:/path/to/file") "file"))
- (should (string-equal
- (file-name-nondirectory "/method:host:/path/to/file/") ""))
- (should-not (file-remote-p
- (unhandled-file-name-directory "/method:host:/path/to/file"))))
+ (should
+ (string-equal
+ (directory-file-name "/method:host:/path/to/file")
+ "/method:host:/path/to/file"))
+ (should
+ (string-equal
+ (directory-file-name "/method:host:/path/to/file/")
+ "/method:host:/path/to/file"))
+ (should
+ (string-equal
+ (file-name-as-directory "/method:host:/path/to/file")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal
+ (file-name-as-directory "/method:host:/path/to/file/")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:/path/to/file")
+ "/method:host:/path/to/"))
+ (should
+ (string-equal
+ (file-name-directory "/method:host:/path/to/file/")
+ "/method:host:/path/to/file/"))
+ (should
+ (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file"))
+ (should
+ (string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
+ (should-not
+ (file-remote-p
+ (unhandled-file-name-directory "/method:host:/path/to/file"))))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
(ert-deftest tramp-test08-file-local-copy ()
"Check `file-local-copy'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name1 (tramp--test-make-temp-name))
tmp-name2)
(unwind-protect
(ert-deftest tramp-test09-insert-file-contents ()
"Check `insert-file-contents'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(ert-deftest tramp-test10-write-region ()
"Check `write-region'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(ert-deftest tramp-test11-copy-file ()
"Check `copy-file'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(unwind-protect
(ert-deftest tramp-test12-rename-file ()
"Check `rename-file'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(unwind-protect
"Check `make-directory'.
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(ert-deftest tramp-test14-delete-directory ()
"Check `delete-directory'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
;; Delete empty directory.
(make-directory tmp-name)
;; Delete non-empty directory.
(make-directory tmp-name)
(write-region "foo" nil (expand-file-name "bla" tmp-name))
- (should-error (delete-directory tmp-name))
+ (should-error (delete-directory tmp-name) :type 'file-error)
(delete-directory tmp-name 'recursive)
(should-not (file-directory-p tmp-name))))
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
+
(let* ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (expand-file-name
(write-region "foo" nil tmp-name4)
(should (file-directory-p tmp-name1))
(should (file-exists-p tmp-name4))
- (copy-directory tmp-name1 tmp-name2)
+ ;; We do not care, whether file permissions and time stamps
+ ;; are correct. Sometimes, it is not possible to manage
+ ;; them, for example in tramp-adb.el.
+ (ignore-errors (copy-directory tmp-name1 tmp-name2))
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
;; Target directory does exist already.
- (copy-directory tmp-name1 tmp-name2)
+ (ignore-errors (copy-directory tmp-name1 tmp-name2))
(should (file-directory-p tmp-name3))
(should (file-exists-p tmp-name6)))
- (delete-directory tmp-name1 'recursive)
- (delete-directory tmp-name2 'recursive))))
+ (ignore-errors
+ (delete-directory tmp-name1 'recursive)
+ (delete-directory tmp-name2 'recursive)))))
(ert-deftest tramp-test16-directory-files ()
"Check `directory-files'."
(skip-unless (tramp--test-enabled))
+
(let* ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (expand-file-name "bla" tmp-name1))
(tmp-name3 (expand-file-name "foo" tmp-name1)))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
`(,tmp-name2 ,tmp-name3))))
- (delete-directory tmp-name1 'recursive))))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test17-insert-directory ()
"Check `insert-directory'."
(skip-unless (tramp--test-enabled))
+
(let* ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (expand-file-name "foo" tmp-name1)))
(unwind-protect
(file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
(goto-char (point-min))
(should
- (looking-at-p "total +[[:digit:]]+\n.+ \\.\n.+ \\.\\.\n.+ foo$"))))
- (delete-directory tmp-name1 'recursive))))
+ (looking-at-p
+ "\\(total.+[[:digit:]]+\n\\)?.+ \\.\n.+ \\.\\.\n.+ foo$"))))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p' and `file-regular-p'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name))
attr)
(unwind-protect
(should-not (file-regular-p tmp-name))
(setq attr (file-attributes tmp-name))
(should (eq (car attr) t)))
- (delete-directory tmp-name))))
+ (ignore-errors (delete-directory tmp-name)))))
(ert-deftest tramp-test19-directory-files-and-attributes ()
"Check `directory-files-and-attributes'."
(skip-unless (tramp--test-enabled))
- (let ((tmp-name (tramp--test-make-temp-name))
- attr)
+
+ ;; `directory-files-and-attributes' contains also values for "../".
+ ;; We must nesure, that this doesn't change during tests, for
+ ;; example due to handling temporary files.
+ (let* ((tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (expand-file-name "bla" tmp-name1))
+ attr)
(unwind-protect
(progn
- (make-directory tmp-name)
- (should (file-directory-p tmp-name))
- (write-region "foo" nil (expand-file-name "foo" tmp-name))
- (write-region "bar" nil (expand-file-name "bar" tmp-name))
- (write-region "boz" nil (expand-file-name "boz" tmp-name))
- (setq attr (directory-files-and-attributes tmp-name))
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (make-directory tmp-name2)
+ (should (file-directory-p tmp-name2))
+ (write-region "foo" nil (expand-file-name "foo" tmp-name2))
+ (write-region "bar" nil (expand-file-name "bar" tmp-name2))
+ (write-region "boz" nil (expand-file-name "boz" tmp-name2))
+ (setq attr (directory-files-and-attributes tmp-name2))
(should (consp attr))
(dolist (elt attr)
(should
- (equal (file-attributes (expand-file-name (car elt) tmp-name))
+ (equal (file-attributes (expand-file-name (car elt) tmp-name2))
(cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name 'full))
+ (setq attr (directory-files-and-attributes tmp-name2 'full))
(dolist (elt attr)
(should
(equal (file-attributes (car elt)) (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name nil "^b"))
+ (setq attr (directory-files-and-attributes tmp-name2 nil "^b"))
(should (equal (mapcar 'car attr) '("bar" "boz"))))
- (delete-directory tmp-name 'recursive))))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test20-file-modes ()
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(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))))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(should (= (file-modes tmp-name) #o444))
(should-not (file-executable-p tmp-name))
;; A file is always writable for user "root".
- (unless (string-equal (file-remote-p tmp-name 'user) "root")
+ (when (not (string-equal (file-remote-p tmp-name 'user) "root"))
(should-not (file-writable-p tmp-name))))
- (delete-file tmp-name))))
+ (ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test21-file-links ()
"Check `file-symlink-p'.
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 (make-temp-name "tramp-")))
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
- (make-symbolic-link tmp-name1 tmp-name2)
+ ;; Method "smb" supports `make-symbolic-link' only if the
+ ;; remote host has CIFS capabilities. tramp-adb.el and
+ ;; tramp-gvfs.el do not support symbolic links at all.
+ (condition-case err
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (file-error
+ (skip-unless
+ (not (string-equal (error-message-string err)
+ "make-symbolic-link not supported")))))
(should (file-symlink-p tmp-name2))
(should-error (make-symbolic-link tmp-name1 tmp-name2))
(make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
(should (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (make-symbolic-link tmp-name1 tmp-name3)))
- (delete-file tmp-name1)
- (delete-file tmp-name2))
+ (ignore-errors
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)))
(unwind-protect
(progn
(should-not (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (add-name-to-file tmp-name1 tmp-name3)))
- (delete-file tmp-name1)
- (delete-file tmp-name2))
+ (ignore-errors
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)))
(unwind-protect
(progn
(should (file-exists-p tmp-name1))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name2))
- (should (string-equal (file-truename tmp-name2) tmp-name1)))
- (delete-file tmp-name1)
- (delete-file tmp-name2))))
+ (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
+ (should
+ (string-equal (file-truename tmp-name1) (file-truename tmp-name2))))
+ (ignore-errors
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)))
+
+ ;; `file-truename' shall preserve trailing link of directories.
+ (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
+ (dir2 (file-name-as-directory dir1)))
+ (should (string-equal (file-truename dir1) (expand-file-name dir1)))
+ (should (string-equal (file-truename dir2) (expand-file-name dir2))))))
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
(skip-unless (tramp--test-enabled))
+ (skip-unless
+ (not
+ (memq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
+
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (tramp--test-make-temp-name)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (consp (nth 5 (file-attributes tmp-name1))))
- ;; '(0 0) means don't know, and will be replaced by `current-time'.
- (set-file-times tmp-name1 '(0 1))
+ ;; '(0 0) means don't know, and will be replaced by
+ ;; `current-time'. Therefore, we use '(0 1).
+ ;; We skip the test, if the remote handler is not able to
+ ;; set the correct time.
+ (skip-unless (set-file-times tmp-name1 '(0 1)))
+ ;; Dumb busyboxes are not able to return the date correctly.
+ ;; They say "don't know.
+ (skip-unless (not (equal (nth 5 (file-attributes tmp-name1)) '(0 0))))
(should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
;; `tmp-name3' does not exist.
(should (file-newer-than-file-p tmp-name2 tmp-name3))
(should-not (file-newer-than-file-p tmp-name3 tmp-name1)))
- (delete-file tmp-name1)
- (delete-file tmp-name2))))
+ (ignore-errors
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)))))
(ert-deftest tramp-test23-visited-file-modtime ()
"Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(set-visited-file-modtime '(0 1))
(should (verify-visited-file-modtime))
(should (equal (visited-file-modtime) '(0 1 0 0)))))
- (delete-file tmp-name))))
+ (ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test24-file-name-completion ()
"Check `file-name-completion' and `file-name-all-completions'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(should
(equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
'("bold" "boz/"))))
- (delete-directory tmp-name 'recursive))))
+ (ignore-errors (delete-directory tmp-name 'recursive)))))
(ert-deftest tramp-test25-load ()
"Check `load'."
(skip-unless (tramp--test-enabled))
+
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
- (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
- (delete-file tmp-name))))
+ (ignore-errors
+ (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
+ (delete-file tmp-name)))))
(ert-deftest tramp-test26-process-file ()
"Check `process-file'."
(skip-unless (tramp--test-enabled))
- (let ((default-directory tramp-test-temporary-file-directory))
- ;; We cannot use "/bin/true" and "/bin/false"; those paths do not
- ;; exist on hydra.
- (should (zerop (process-file "true")))
- (should-not (zerop (process-file "false")))
- (should-not (zerop (process-file "binary-does-not-exist")))
- (with-temp-buffer
- (should (zerop (process-file "ls" nil t)))
- (should (> (point-max) (point-min))))))
+ (skip-unless
+ (not
+ (memq
+ (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)
+ (unwind-protect
+ (progn
+ ;; We cannot use "/bin/true" and "/bin/false"; those paths
+ ;; do not exist on hydra.
+ (should (zerop (process-file "true")))
+ (should-not (zerop (process-file "false")))
+ (should-not (zerop (process-file "binary-does-not-exist")))
+ (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)))))
+ (ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test27-start-file-process ()
"Check `start-file-process'."
(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))))
+
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name))
kill-buffer-query-functions proc)
(process-send-eof proc)
(accept-process-output proc 1)
(should (string-equal (buffer-string) "foo")))
- (delete-process proc))
+ (ignore-errors (delete-process proc)))
(unwind-protect
(with-temp-buffer
(should (processp proc))
(accept-process-output proc 1)
(should (string-equal (buffer-string) "foo")))
- (delete-process proc)
- (delete-file tmp-name))
+ (ignore-errors
+ (delete-process proc)
+ (delete-file tmp-name)))
(unwind-protect
(progn
(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) (should (string-equal s "foo"))))
(process-send-string proc "foo")
(process-send-eof proc)
(accept-process-output proc 1))
- (delete-process proc))))
+ (ignore-errors (delete-process proc)))))
(ert-deftest tramp-test28-shell-command ()
"Check `shell-command'."
(skip-unless (tramp--test-enabled))
- (let ((default-directory tramp-test-temporary-file-directory))
- (with-temp-buffer
- (shell-command "ls" (current-buffer))
- (should (> (point-max) (point-min))))))
+ (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))))
+
+ (let ((tmp-name (tramp--test-make-temp-name))
+ (default-directory tramp-test-temporary-file-directory)
+ kill-buffer-query-functions)
+ (unwind-protect
+ (with-temp-buffer
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (shell-command
+ (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
+ ;; `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))))
+ (ignore-errors (delete-file tmp-name)))
+
+ (unwind-protect
+ (with-temp-buffer
+ (write-region "foo" nil tmp-name)
+ (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)
+ (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
+ (while
+ (ignore-errors
+ (memq (process-status (get-buffer-process (current-buffer)))
+ '(run open)))
+ (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))
+ (should
+ (string-equal
+ (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
+ (ignore-errors (delete-file tmp-name)))
+
+ (unwind-protect
+ (with-temp-buffer
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (async-shell-command "read line; ls $line" (current-buffer))
+ (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)
+ (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
+ (while
+ (ignore-errors
+ (memq (process-status (get-buffer-process (current-buffer)))
+ '(run open)))
+ (accept-process-output (get-buffer-process (current-buffer)) 1)))
+ (should
+ (string-equal
+ (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string))))
+ (ignore-errors (delete-file tmp-name)))))
+
+(ert-deftest tramp-test29-vc-registered ()
+ "Check `vc-registered'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+
+ (let* ((default-directory tramp-test-temporary-file-directory)
+ (tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ (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))
+ '(Bzr))
+ ((tramp-find-executable v vc-git-program (tramp-get-remote-path v))
+ '(Git))
+ ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v))
+ '(Hg))
+ (t nil)))))
+ (skip-unless vc-handled-backends)
+ (message "%s" vc-handled-backends)
+
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name2)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name2))
+ (should-not (vc-registered tmp-name1))
+ (should-not (vc-registered tmp-name2))
+
+ (let ((default-directory tmp-name1))
+ ;; Create empty repository, and register the file.
+ (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)))))
+ (should (vc-registered tmp-name2)))
+
+ (ignore-errors (delete-directory tmp-name1 'recursive)))))
+
+(ert-deftest tramp-test30-utf8 ()
+ "Check UTF8 encoding in file names and file contents."
+ (skip-unless (tramp--test-enabled))
+
+ (let ((tmp-name (tramp--test-make-temp-name))
+ (coding-system-for-read 'utf-8)
+ (coding-system-for-write 'utf-8)
+ (arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
+ (chinese "银河系漫游指南系列")
+ (russian "Автостопом по гала́ктике"))
+ (unwind-protect
+ (progn
+ (make-directory tmp-name)
+ (dolist (lang `(,arabic ,chinese ,russian))
+ (let ((file (expand-file-name lang tmp-name)))
+ (write-region lang nil file)
+ (should (file-exists-p file))
+ ;; Check file contents.
+ (with-temp-buffer
+ (insert-file-contents file)
+ (should (string-equal (buffer-string) lang)))))
+ ;; Check file names.
+ (should (equal (directory-files
+ tmp-name nil directory-files-no-dot-files-regexp)
+ (sort `(,arabic ,chinese ,russian) 'string-lessp))))
+ (ignore-errors (delete-directory tmp-name 'recursive)))))
;; TODO:
;; * make-auto-save-file-name
;; * set-file-acl
;; * set-file-selinux-context
-;; * vc-registered
+
+;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
+;; * Fix `tramp-test28-shell-command' on MS Windows (`process-send-eof'?).
+;; * Fix `tramp-test30-utf8' on MS Windows. Seems to be in `directory-files'.
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."