diff options
Diffstat (limited to 'test/lisp/net/tramp-tests.el')
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 241 |
1 files changed, 116 insertions, 125 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e05786fa07..af705f6ce6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -639,23 +639,24 @@ This checks also `file-name-as-directory', `file-name-directory', (unhandled-file-name-directory "/method:host:/path/to/file")) ;; Bug#10085. - (dolist (n-e '(nil t)) - ;; We must clear `tramp-default-method'. On hydra, it is "ftp", - ;; which ruins the tests. - (let ((non-essential n-e) - tramp-default-method) - (dolist (file - `(,(file-remote-p tramp-test-temporary-file-directory 'method) - ,(file-remote-p tramp-test-temporary-file-directory 'host))) - (unless (zerop (length file)) - (setq file (format "/%s:" file)) - (should (string-equal (directory-file-name file) file)) - (should - (string-equal - (file-name-as-directory file) - (if (tramp-completion-mode-p) file (concat file "./")))) - (should (string-equal (file-name-directory file) file)) - (should (string-equal (file-name-nondirectory file) ""))))))) + (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. + (dolist (n-e '(nil t)) + ;; We must clear `tramp-default-method'. On hydra, it is "ftp", + ;; which ruins the tests. + (let ((non-essential n-e) + tramp-default-method) + (dolist (file + `(,(file-remote-p tramp-test-temporary-file-directory 'method) + ,(file-remote-p tramp-test-temporary-file-directory 'host))) + (unless (zerop (length file)) + (setq file (format "/%s:" file)) + (should (string-equal (directory-file-name file) file)) + (should + (string-equal + (file-name-as-directory file) + (if (tramp-completion-mode-p) file (concat file "./")))) + (should (string-equal (file-name-directory file) file)) + (should (string-equal (file-name-nondirectory file) "")))))))) (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." @@ -1091,7 +1092,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. -This tests also `file-readable-p' and `file-regular-p'." +This tests also `file-readable-p', `file-regular-p' and +`file-ownership-preserved-p'." (skip-unless (tramp--test-enabled)) ;; We must use `file-truename' for the temporary directory, because @@ -1111,10 +1113,16 @@ This tests also `file-readable-p' and `file-regular-p'." attr) (unwind-protect (progn + ;; `file-ownership-preserved-p' should return t for + ;; non-existing files. It is implemented only in tramp-sh.el. + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) ;; We do not test inodes and device numbers. (setq attr (file-attributes tmp-name1)) @@ -1138,9 +1146,13 @@ This tests also `file-readable-p' and `file-regular-p'." (condition-case err (progn + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) (make-symbolic-link tmp-name1 tmp-name2) (should (file-exists-p tmp-name2)) (should (file-symlink-p tmp-name2)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) (setq attr (file-attributes tmp-name2)) (should (string-equal (car attr) @@ -1167,11 +1179,15 @@ This tests also `file-readable-p' and `file-regular-p'." (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)))) (delete-file tmp-name2)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) (delete-file tmp-name1) (make-directory tmp-name1) (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should-not (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) (setq attr (file-attributes tmp-name1)) (should (eq (car attr) t))) @@ -1227,13 +1243,7 @@ This tests also `file-readable-p' and `file-regular-p'." "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)))) + (skip-unless (tramp--test-sh-p)) (let ((tmp-name (tramp--test-make-temp-name))) (unwind-protect @@ -1337,11 +1347,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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)))) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (let ((tmp-name1 (tramp--test-make-temp-name)) (tmp-name2 (tramp--test-make-temp-name)) @@ -1499,11 +1505,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `process-file'." :tags '(:expensive-test) (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)))) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (let* ((tmp-name (tramp--test-make-temp-name)) (fnnd (file-name-nondirectory tmp-name)) @@ -1548,13 +1550,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `start-file-process'." :tags '(:expensive-test) (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)))) + (skip-unless (tramp--test-sh-p)) (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name)) @@ -1569,7 +1565,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Read output. (with-timeout (10 (ert-fail "`start-file-process' timed out")) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) + (accept-process-output proc 0.1))) (should (string-equal (buffer-string) "foo"))) ;; Cleanup. @@ -1587,7 +1583,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Read output. (with-timeout (10 (ert-fail "`start-file-process' timed out")) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) + (accept-process-output proc 0.1))) (should (string-equal (buffer-string) "foo"))) ;; Cleanup. @@ -1608,7 +1604,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Read output. (with-timeout (10 (ert-fail "`start-file-process' timed out")) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) + (accept-process-output proc 0.1))) (should (string-equal (buffer-string) "foo"))) ;; Cleanup. @@ -1618,13 +1614,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `shell-command'." :tags '(:expensive-test) (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)))) + (skip-unless (tramp--test-sh-p)) (let ((tmp-name (tramp--test-make-temp-name)) (default-directory tramp-test-temporary-file-directory) @@ -1657,7 +1647,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (ert-fail "`async-shell-command' timed out")) (while (< (- (point-max) (point-min)) (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -1686,7 +1677,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (ert-fail "`async-shell-command' timed out")) (while (< (- (point-max) (point-min)) (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) @@ -1708,9 +1700,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (async-shell-command command (current-buffer)) ;; Suppress nasty messages. (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (while (get-buffer-process (current-buffer)) - (accept-process-output (get-buffer-process (current-buffer)) 0.1)) - (accept-process-output) + (with-timeout (10) + (while (get-buffer-process (current-buffer)) + (accept-process-output (get-buffer-process (current-buffer)) 0.1))) + (accept-process-output nil 0.1) (buffer-substring-no-properties (point-min) (point-max)))) ;; This test is inspired by Bug#23952. @@ -1718,10 +1711,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check that remote processes set / unset environment variables properly." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (tramp--test-sh-p)) (dolist (this-shell-command-to-string '(;; Synchronously. @@ -1798,10 +1788,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `vc-registered'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (tramp--test-sh-p)) (let* ((default-directory tramp-test-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name)) @@ -1947,6 +1934,36 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-directory tmp-name2 'recursive))))) +(ert-deftest tramp-test32-make-nearby-temp-file () + "Check `make-nearby-temp-file' and `temporary-file-directory'." + (skip-unless (tramp--test-enabled)) + + (let ((default-directory tramp-test-temporary-file-directory) + tmp-file) + ;; The remote host shall know a tempory file directory. + (should (stringp (temporary-file-directory))) + (should + (string-equal + (file-remote-p default-directory) + (file-remote-p (temporary-file-directory)))) + + ;; The temporary file shall be located on the remote host. + (setq tmp-file (make-nearby-temp-file "tramp-test")) + (should (file-exists-p tmp-file)) + (should (file-regular-p tmp-file)) + (should + (string-equal + (file-remote-p default-directory) + (file-remote-p tmp-file))) + (delete-file tmp-file) + (should-not (file-exists-p tmp-file)) + + (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir)) + (should (file-exists-p tmp-file)) + (should (file-directory-p tmp-file)) + (delete-directory tmp-file) + (should-not (file-exists-p tmp-file)))) + (defun tramp--test-adb-p () "Check, whether the remote host runs Android. This requires restrictions of file name syntax." @@ -1956,11 +1973,13 @@ This requires restrictions of file name syntax." "Check, whether an FTP-like method is used. This does not support globbing characters in file names (yet)." ;; Globbing characters are ??, ?* and ?\[. - (and (eq (tramp-find-foreign-file-name-handler - tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler) - (string-match - "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))) + (string-match + "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) + +(defun tramp--test-gvfs-p () + "Check, whether the remote host runs a GVFS based method. +This requires restrictions of file name syntax." + (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) (defun tramp--test-rsync-p () "Check, whether the rsync method is used. @@ -1968,10 +1987,11 @@ This does not support special file names." (string-equal "rsync" (file-remote-p tramp-test-temporary-file-directory 'method))) -(defun tramp--test-gvfs-p () - "Check, whether the remote host runs a GVFS based method. -This requires restrictions of file name syntax." - (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) +(defun tramp--test-sh-p () + "Check, whether the remote host runs a based method from tramp-sh.el." + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) (defun tramp--test-smb-or-windows-nt-p () "Check, whether the locale or remote host runs MS Windows. @@ -2123,7 +2143,7 @@ Several special characters do not work properly there." (ignore-errors (delete-directory tmp-name2 'recursive))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test32-special-characters*'." + "Perform the test in `tramp-test33-special-characters*'." ;; Newlines, slashes and backslashes in file names are not ;; supported. So we don't test. And we don't test the tab ;; character on Windows or Cygwin, because the backslash is @@ -2164,23 +2184,19 @@ Several special characters do not work properly there." "{foo}bar{baz}")) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test32-special-characters () +(ert-deftest tramp-test33-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) (tramp--test-special-characters)) -(ert-deftest tramp-test32-special-characters-with-stat () +(ert-deftest tramp-test33-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-stat v))) @@ -2191,16 +2207,12 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test32-special-characters-with-perl () +(ert-deftest tramp-test33-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-perl v))) @@ -2214,16 +2226,12 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test32-special-characters-with-ls () +(ert-deftest tramp-test33-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (let ((tramp-connection-properties (append @@ -2238,7 +2246,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test33-utf8*'." + "Perform the test in `tramp-test34-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -2252,23 +2260,19 @@ Use the `ls' command." "银河系漫游指南系列" "Автостопом по гала́ктике"))) -(ert-deftest tramp-test33-utf8 () +(ert-deftest tramp-test34-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) (tramp--test-utf8)) -(ert-deftest tramp-test33-utf8-with-stat () +(ert-deftest tramp-test34-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-stat v))) @@ -2279,16 +2283,12 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test33-utf8-with-perl () +(ert-deftest tramp-test34-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (skip-unless (tramp-get-remote-perl v))) @@ -2302,16 +2302,12 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test33-utf8-with-ls () +(ert-deftest tramp-test34-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (not (tramp--test-rsync-p))) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p)))) (let ((tramp-connection-properties (append @@ -2326,7 +2322,7 @@ Use the `ls' command." (tramp--test-utf8))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test34-asynchronous-requests () +(ert-deftest tramp-test35-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -2334,10 +2330,7 @@ process sentinels. They shall not disturb each other." :expected-result :failed :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) + (skip-unless (tramp--test-sh-p)) ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This ;; has the side effect, that this test fails instead to abort. Good @@ -2416,7 +2409,7 @@ process sentinels. They shall not disturb each other." (dolist (buf buffers) (ignore-errors (kill-buffer buf))))))) -(ert-deftest tramp-test35-recursive-load () +(ert-deftest tramp-test36-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -2439,7 +2432,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test36-unload () +(ert-deftest tramp-test37-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." ;; Mark as failed until all symbols are unbound. @@ -2477,7 +2470,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * dired-compress-file ;; * dired-uncache ;; * file-acl -;; * file-ownership-preserved-p ;; * file-selinux-context ;; * find-backup-file-name ;; * set-file-acl @@ -2485,10 +2477,9 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. -;; * Fix `tramp-test15-copy-directory' for `rsync'. ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#16928. Set expected error of `tramp-test34-asynchronous-requests'. -;; * Fix `tramp-test36-unload' (Not all symbols are unbound). Set +;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'. +;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set ;; expected error. (defun tramp-test-all (&optional interactive) |