diff options
Diffstat (limited to 'test/lisp/net/tramp-tests.el')
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 1232 |
1 files changed, 975 insertions, 257 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 70b2646cc89..ff63dc18fbc 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,7 +33,7 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. -;; For slow remote connections, `tramp-test41-asynchronous-requests' +;; For slow remote connections, `tramp-test43-asynchronous-requests' ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper ;; value less than 10 could help. @@ -52,14 +52,27 @@ (declare-function tramp-find-executable "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") -(declare-function tramp-get-remote-stat "tramp-sh") (declare-function tramp-get-remote-perl "tramp-sh") +(declare-function tramp-get-remote-stat "tramp-sh") +(declare-function tramp-method-out-of-band-p "tramp-sh") +(declare-function tramp-smb-get-localname "tramp-smb") (defvar auto-save-file-name-transforms) +(defvar tramp-connection-properties) (defvar tramp-copy-size-limit) +(defvar tramp-display-escape-sequence-regexp) +(defvar tramp-inline-compress-start-size) (defvar tramp-persistency-file-name) +(defvar tramp-remote-path) (defvar tramp-remote-process-environment) -;; Suppress nasty messages. -(fset 'shell-command-sentinel 'ignore) + +;; Beautify batch mode. +(when noninteractive + ;; Suppress nasty messages. + (fset 'shell-command-sentinel 'ignore) + ;; We do not want to be interrupted. + (eval-after-load 'tramp-gvfs + '(fset 'tramp-gvfs-handler-askquestion + (lambda (_message _choices) '(t nil 0))))) ;; There is no default value on w32 systems, which could work out of the box. (defconst tramp-test-temporary-file-directory @@ -84,7 +97,8 @@ (format "/mock::%s" temporary-file-directory))) "Temporary directory for Tramp tests.") -(setq password-cache-expiry nil +(setq auth-source-save-behavior nil + password-cache-expiry nil tramp-verbose 0 tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil @@ -95,11 +109,6 @@ (when (getenv "EMACS_HYDRA_CI") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) -(defvar tramp--test-expensive-test - (null - (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) - "Whether expensive tests are run.") - (defvar tramp--test-enabled-checked nil "Cached result of `tramp--test-enabled'. If the function did run, the value is a cons cell, the `cdr' @@ -127,6 +136,13 @@ being the result.") ;; Return result. (cdr tramp--test-enabled-checked)) +(defsubst tramp--test-expensive-test () + "Whether expensive tests are run." + (ert-select-tests + (ert--stats-selector ert--current-run-stats) + (list (make-ert-test :name (ert-test-name (ert-running-test)) + :body nil :tags '(:expensive-test))))) + (defun tramp--test-make-temp-name (&optional local quoted) "Return a temporary file name for test. If LOCAL is non-nil, a local file name is returned. @@ -179,6 +195,16 @@ handled properly. BODY shall not contain a timeout." (tramp-backtrace (tramp-dissect-file-name tramp-test-temporary-file-directory)))) +(defmacro tramp--test-print-duration (message &rest body) + "Run BODY and print a message with duration, prompted by MESSAGE." + (declare (indent 1) (debug (stringp body))) + `(let ((start (current-time))) + (unwind-protect + (progn ,@body) + (tramp--test-message + "%s %f sec" + ,message (float-time (time-subtract (current-time) start)))))) + (ert-deftest tramp-test00-availability () "Test availability of Tramp functions." :expected-result (if (tramp--test-enabled) :passed :failed) @@ -229,6 +255,9 @@ handled properly. BODY shall not contain a timeout." ;; No strings. (should-not (tramp-tramp-file-p nil)) (should-not (tramp-tramp-file-p 'symbol)) + ;; No newline or linefeed. + (should-not (tramp-tramp-file-p "/method::file\nname")) + (should-not (tramp-tramp-file-p "/method::file\rname")) ;; Ange-ftp syntax. (should-not (tramp-tramp-file-p "/host:")) (should-not (tramp-tramp-file-p "/user@host:")) @@ -242,6 +271,12 @@ handled properly. BODY shall not contain a timeout." (should-not (tramp-tramp-file-p "/::")) (should-not (tramp-tramp-file-p "/:@:")) (should-not (tramp-tramp-file-p "/:[]:")) + ;; When `tramp-mode' is nil, Tramp is not activated. + (let (tramp-mode) + (should-not (tramp-tramp-file-p "/method:user@host:"))) + ;; `tramp-ignored-file-name-regexp' suppresses Tramp. + (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) + (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; Methods shall be at least two characters on MS Windows, except ;; the default method. (let ((system-type 'windows-nt)) @@ -365,7 +400,13 @@ handled properly. BODY shall not contain a timeout." "Check remote file name components." (let ((tramp-default-method "default-method") (tramp-default-user "default-user") - (tramp-default-host "default-host")) + (tramp-default-host "default-host") + tramp-default-method-alist + tramp-default-user-alist + tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t)))) ;; Expand `tramp-default-user' and `tramp-default-host'. (should (string-equal (file-remote-p "/method::") @@ -715,7 +756,84 @@ handled properly. BODY shall not contain a timeout." "|method3:user3@host3:/path/to/file") 'hop) (format "%s:%s@%s|%s:%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))))) + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/-:user1@host1" + "|-:user2@host2" + "|-:user3@host3:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:host1" + "|method2:host2" + "|method3:host3:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host1" + "method3" "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:%u@%h" + "|method2:user2@host2" + "|method3:%u@%h" + "|method4:user4%domain4@host4#1234:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user2" "host2" + "method2" "user2" "host2" + "method3" "user4" "host4" + "method4" "user4%domain4" "host4#1234"))))) (ert-deftest tramp-test02-file-name-dissect-simplified () "Check simplified file name components." @@ -723,6 +841,11 @@ handled properly. BODY shall not contain a timeout." (let ((tramp-default-method "default-method") (tramp-default-user "default-user") (tramp-default-host "default-host") + tramp-default-user-alist + tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t))) (syntax tramp-syntax)) (unwind-protect (progn @@ -970,7 +1093,67 @@ handled properly. BODY shall not contain a timeout." "|user3@host3:/path/to/file") 'hop) (format "%s@%s|%s@%s|" - "user1" "host1" "user2" "host2")))) + "user1" "host1" "user2" "host2"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) + (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) + (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/host1" + "|host2" + "|host3:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host2" + "user3" "host3"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) + (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) + (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@" + "|user2@" + "|user3@:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host2" + "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@" + "|user3@:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s:" + "user1" "host1" + "user2" "host1" + "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/%u@%h" + "|user2@host2" + "|%u@%h" + "|user4%domain4@host4#1234:/path/to/file")) + (format "/%s@%s|%s@%s|%s@%s|%s@%s:" + "user2" "host2" + "user2" "host2" + "user4" "host4" + "user4%domain4" "host4#1234")))) ;; Exit. (tramp-change-syntax syntax)))) @@ -981,6 +1164,12 @@ handled properly. BODY shall not contain a timeout." (let ((tramp-default-method "default-method") (tramp-default-user "default-user") (tramp-default-host "default-host") + tramp-default-method-alist + tramp-default-user-alist + tramp-default-host-alist + ;; Suppress check for multihops. + (tramp-cache-data (make-hash-table :test 'equal)) + (tramp-connection-properties '((nil "login-program" t))) (syntax tramp-syntax)) (unwind-protect (progn @@ -1538,7 +1727,84 @@ handled properly. BODY shall not contain a timeout." "|method3/user3@host3]/path/to/file") 'hop) (format "%s/%s@%s|%s/%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2")))) + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/[/user1@host1" + "|/user2@host2" + "|/user3@host3]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/host1" + "|method2/host2" + "|method3/host3]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user1" "host1" + "method2" "user2" "host1" + "method3" "user3" "host1"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/%u@%h" + "|method2/user2@host2" + "|method3/%u@%h" + "|method4/user4%domain4@host4#1234]/path/to/file")) + (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s|%s/%s@%s]" + "method1" "user2" "host2" + "method2" "user2" "host2" + "method3" "user4" "host4" + "method4" "user4%domain4" "host4#1234")))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1567,41 +1833,112 @@ handled properly. BODY shall not contain a timeout." ;; Default values in tramp-smb.el. (should (string-equal (file-remote-p "/smb::" 'user) nil))) +;; The following test is inspired by Bug#30946. +(ert-deftest tramp-test03-file-name-host-rules () + "Check host name rules for host-less methods." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + ;; `user-error' has appeared in Emacs 24.3. + (skip-unless (fboundp 'user-error)) + + ;; Host names must match rules in case the command template of a + ;; method doesn't use them. + (dolist (m '("su" "sg" "sudo" "doas" "ksu")) + (let ((vec (tramp-dissect-file-name tramp-test-temporary-file-directory)) + tramp-connection-properties tramp-default-proxies-alist) + (ignore-errors (tramp-cleanup-connection vec nil 'keep-password)) + ;; Single hop. The host name must match `tramp-local-host-regexp'. + (should-error + (find-file (format "/%s:foo:" m)) + :type 'user-error) + ;; Multi hop. The host name must match the previous hop. + (should-error + (find-file + (format + "%s|%s:foo:" + (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1) + m)) + :type 'user-error)))) + +(ert-deftest tramp-test03-file-name-method-rules () + "Check file name rules for some methods." + (skip-unless (tramp--test-enabled)) + ;; `user-error' has appeared in Emacs 24.3. + (skip-unless (fboundp 'user-error)) + + ;; Multi hops are allowed for inline methods only. + (should-error + (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file") + :type 'user-error) + (should-error + (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file") + :type 'user-error) + + ;; Samba does not support file names with periods followed by + ;; spaces, and trailing periods or spaces. + (when (tramp-smb-file-name-p tramp-test-temporary-file-directory) + (dolist (file '("foo." "foo. bar" "foo ")) + (should-error + (tramp-smb-get-localname + (tramp-dissect-file-name + (expand-file-name file tramp-test-temporary-file-directory))) + :type 'file-error)))) + (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:///foo") "/foo")) (should (string-equal - (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) + (substitute-in-file-name "/method:host://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")) ;; Quoting local part. (should (string-equal - (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) + (substitute-in-file-name "/method:host:/:///foo") "/method:host:/:///foo")) (should (string-equal - (substitute-in-file-name "/method:host:/:/path//foo") - "/method:host:/:/path//foo")) + (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) (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//foo")) (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")) + (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo")) + (should + (string-equal (substitute-in-file-name "/method:host:/path//~foo") "/~foo")) + ;; (substitute-in-file-name "/path/~foo") expands only for a local + ;; user "foo" to "/~foo"". Otherwise, it doesn't expand. (should - (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) + (string-equal + (substitute-in-file-name + "/method:host:/path/~foo") "/method:host:/path/~foo")) ;; Quoting local part. (should (string-equal - (substitute-in-file-name "/method:host:/:/path/~/foo") - "/method:host:/:/path/~/foo")) + (substitute-in-file-name "/method:host:/://~foo") "/method:host:/://~foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo")) (should (string-equal - (substitute-in-file-name "/method:host:/:/path//~/foo") - "/method:host:/:/path//~/foo")) + (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/~foo")) (let (process-environment) (should @@ -1661,8 +1998,9 @@ handled properly. BODY shall not contain a timeout." ;; Mark as failed until bug has been fixed. :expected-result :failed (skip-unless (tramp--test-enabled)) + ;; These are the methods the test doesn't fail. - (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) + (when (or (tramp--test-adb-p) (tramp--test-gvfs-p) (tramp--test-rclone-p) (tramp-smb-file-name-p tramp-test-temporary-file-directory)) (setf (ert-test-expected-result-type (ert-get-test 'tramp-test05-expand-file-name-relative)) @@ -1709,6 +2047,14 @@ This checks also `file-name-as-directory', `file-name-directory', (file-name-directory "/method:host:/path/to/file/") "/method:host:/path/to/file/")) (should + (string-equal (file-name-directory "/method:host:file") "/method:host:")) + (should + (string-equal + (file-name-directory "/method:host:path/") "/method:host:path/")) + (should + (string-equal + (file-name-directory "/method:host:path/to") "/method:host:path/")) + (should (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) (should (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) @@ -1743,7 +2089,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `file-exist-p', `write-region' and `delete-file'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (should-not (file-exists-p tmp-name)) (write-region "foo" nil tmp-name) @@ -1755,7 +2101,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `file-local-copy'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) tmp-name2) (unwind-protect @@ -1787,7 +2133,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `insert-file-contents'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (with-temp-buffer @@ -1815,7 +2161,7 @@ This checks also `file-name-as-directory', `file-name-directory', "Check `write-region'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn @@ -1905,7 +2251,7 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) @@ -1930,9 +2276,10 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-file-contents target) (should (string-equal (buffer-string) "foo"))) - (should-error - (copy-file source target) - :type 'file-already-exists) + (when (tramp--test-expensive-test) + (should-error + (copy-file source target) + :type 'file-already-exists)) (copy-file source target 'ok)) ;; Cleanup. @@ -1941,13 +2288,15 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy file to directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-nextcloud-p) (write-region "foo" nil source) (should (file-exists-p source)) (make-directory target) (should (file-directory-p target)) ;; This has been changed in Emacs 26.1. - (when (tramp--test-emacs26-p) + (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p)) (should-error (copy-file source target) :type 'file-already-exists)) @@ -1962,7 +2311,11 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory to existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (and (tramp--test-nextcloud-p) + (or (not (file-remote-p source)) + (not (file-remote-p target)))) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -1983,7 +2336,10 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory/file to non-existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless + (and (tramp--test-nextcloud-p) (not (file-remote-p source))) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2007,7 +2363,7 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) @@ -2035,9 +2391,10 @@ This checks also `file-name-as-directory', `file-name-directory', (should (string-equal (buffer-string) "foo"))) (write-region "foo" nil source) (should (file-exists-p source)) - (should-error - (rename-file source target) - :type 'file-already-exists) + (when (tramp--test-expensive-test) + (should-error + (rename-file source target) + :type 'file-already-exists)) (rename-file source target 'ok) (should-not (file-exists-p source))) @@ -2053,7 +2410,7 @@ This checks also `file-name-as-directory', `file-name-directory', (make-directory target) (should (file-directory-p target)) ;; This has been changed in Emacs 26.1. - (when (tramp--test-emacs26-p) + (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p)) (should-error (rename-file source target) :type 'file-already-exists)) @@ -2069,7 +2426,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory to existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2091,7 +2450,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory/file to non-existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2116,7 +2477,7 @@ This checks also `file-name-as-directory', `file-name-directory', This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) (unwind-protect @@ -2139,7 +2500,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "Check `delete-directory'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) ;; Delete empty directory. (make-directory tmp-name) @@ -2159,7 +2520,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "Check `copy-directory'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (expand-file-name @@ -2225,7 +2586,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "Check `directory-files'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "bla" tmp-name1)) (tmp-name3 (expand-file-name "foo" tmp-name1))) @@ -2258,7 +2619,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "Check `file-expand-wildcards'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo" tmp-name1)) (tmp-name3 (expand-file-name "bar" tmp-name1)) @@ -2322,7 +2683,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." "Check `insert-directory'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (expand-file-name (tramp--test-make-temp-name nil quoted))) (tmp-name2 (expand-file-name "foo" tmp-name1)) @@ -2383,7 +2744,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Since Emacs 26.1. (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (expand-file-name (tramp--test-make-temp-name nil quoted))) (tmp-name2 @@ -2500,7 +2861,7 @@ This tests also `file-readable-p', `file-regular-p' and `file-ownership-preserved-p'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This ;; would let the test fail. @@ -2607,7 +2968,7 @@ This tests also `file-readable-p', `file-regular-p' and "Check `directory-files-and-attributes'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) ;; `directory-files-and-attributes' contains also values for ;; "../". Ensure that this doesn't change during tests, for ;; example due to handling temporary files. @@ -2629,16 +2990,17 @@ This tests also `file-readable-p', `file-regular-p' and ;; able to return the date correctly. They say "don't know". (dolist (elt attr) (unless - (equal + (tramp-compat-time-equal-p (nth 5 (file-attributes (expand-file-name (car elt) tmp-name2))) - '(0 0)) + tramp-time-dont-know) (should (equal (file-attributes (expand-file-name (car elt) tmp-name2)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 'full)) (dolist (elt attr) - (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) + (unless (tramp-compat-time-equal-p + (nth 5 (file-attributes (car elt))) tramp-time-dont-know) (should (equal (file-attributes (car elt)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) @@ -2651,9 +3013,9 @@ This tests also `file-readable-p', `file-regular-p' and "Check `file-modes'. This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) + (skip-unless (or (tramp--test-sh-p) (tramp--test-sudoedit-p))) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn @@ -2673,15 +3035,27 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) +;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error. +(defmacro tramp--test-ignore-add-name-to-file-error (&rest body) + "Run BODY, ignoring \"error with add-name-to-file\" file error." + (declare (indent defun) (debug t)) + `(condition-case err + (progn ,@body) + ((error quit debug) + (unless (and (eq (car err) 'file-error) + (string-match "^error with add-name-to-file" + (error-message-string err))) + (signal (car err) (cdr err)))))) + (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)) - ;; The semantics has changed heavily in Emacs 26.1. We cannot test + ;; The semantics have changed heavily in Emacs 26.1. We cannot test ;; older Emacsen, therefore. (skip-unless (tramp--test-emacs26-p)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This ;; would let the test fail. @@ -2705,14 +3079,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if quoted 'tramp-compat-file-name-unquote 'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) - (should-error - (make-symbolic-link tmp-name1 tmp-name2) - :type 'file-already-exists) - ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (when (tramp--test-expensive-test) (should-error - (make-symbolic-link tmp-name1 tmp-name2 0) + (make-symbolic-link tmp-name1 tmp-name2) :type 'file-already-exists)) + (when (tramp--test-expensive-test) + ;; A number means interactive case. + (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (should-error + (make-symbolic-link tmp-name1 tmp-name2 0) + :type 'file-already-exists))) (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) (make-symbolic-link tmp-name1 tmp-name2 0) (should @@ -2747,9 +3123,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (string-equal tmp-name1 (file-symlink-p tmp-name3)))) ;; Check directory as newname. (make-directory tmp-name4) - (should-error - (make-symbolic-link tmp-name1 tmp-name4) - :type 'file-already-exists) + (when (tramp--test-expensive-test) + (should-error + (make-symbolic-link tmp-name1 tmp-name4) + :type 'file-already-exists)) (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4)) (should (string-equal @@ -2771,38 +3148,40 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Check `add-name-to-file'. (unwind-protect - (unless (tramp-smb-file-name-p tramp-test-temporary-file-directory) - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (add-name-to-file tmp-name1 tmp-name2) - (should (file-regular-p tmp-name2)) - (should-error + (when (tramp--test-expensive-test) + (tramp--test-ignore-add-name-to-file-error + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) - :type 'file-already-exists) - ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) - (should-error - (add-name-to-file tmp-name1 tmp-name2 0) - :type 'file-already-exists)) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (should (file-regular-p tmp-name2)) + (should-error + (add-name-to-file tmp-name1 tmp-name2) + :type 'file-already-exists) + ;; A number means interactive case. + (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (should-error + (add-name-to-file tmp-name1 tmp-name2 0) + :type 'file-already-exists)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) (add-name-to-file tmp-name1 tmp-name2 0) (should (file-regular-p tmp-name2))) - (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) - (should-not (file-symlink-p tmp-name2)) - (should (file-regular-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error - (add-name-to-file tmp-name1 tmp-name3) - :type 'file-error) - ;; Check directory as newname. - (make-directory tmp-name4) - (should-error - (add-name-to-file tmp-name1 tmp-name4) - :type 'file-already-exists) - (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) - (should - (file-regular-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))) + (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) + (should-not (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error + (add-name-to-file tmp-name1 tmp-name3) + :type 'file-error) + ;; Check directory as newname. + (make-directory tmp-name4) + (should-error + (add-name-to-file tmp-name1 tmp-name4) + :type 'file-already-exists) + (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) + (should + (file-regular-p + (expand-file-name + (file-name-nondirectory tmp-name1) tmp-name4))))) ;; Cleanup. (ignore-errors @@ -2882,12 +3261,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (string-equal (file-truename tmp-name2) (file-truename tmp-name3))) - (should-error - (with-temp-buffer (insert-file-contents tmp-name2)) - :type tramp-file-missing) - (should-error - (with-temp-buffer (insert-file-contents tmp-name3)) - :type tramp-file-missing) + (when (tramp--test-expensive-test) + (should-error + (with-temp-buffer (insert-file-contents tmp-name2)) + :type tramp-file-missing)) + (when (tramp--test-expensive-test) + (should-error + (with-temp-buffer (insert-file-contents tmp-name3)) + :type tramp-file-missing)) ;; `directory-files' does not show symlinks to ;; non-existing targets in the "smb" case. So we remove ;; the symlinks manually. @@ -2900,32 +3281,42 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Detect cyclic symbolic links. (unwind-protect - (tramp--test-ignore-make-symbolic-link-error - (make-symbolic-link tmp-name2 tmp-name1) - (should (file-symlink-p tmp-name1)) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-symlink-p tmp-name2)) - (should-error (file-truename tmp-name1) :type 'file-error)) + (when (tramp--test-expensive-test) + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link tmp-name2 tmp-name1) + (should (file-symlink-p tmp-name1)) + (if (tramp-smb-file-name-p tramp-test-temporary-file-directory) + ;; The symlink command of `smbclient' detects the + ;; cycle already. + (should-error + (make-symbolic-link tmp-name1 tmp-name2) + :type 'file-error) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-error (file-truename tmp-name1) :type 'file-error)))) ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))) - ;; `file-truename' shall preserve trailing link of directories. - (unless (file-symlink-p tramp-test-temporary-file-directory) - (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)))))))) + ;; `file-truename' shall preserve trailing slash of directories. + (let* ((dir1 + (directory-file-name + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + 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 (or (tramp--test-adb-p) (tramp--test-sh-p))) + (skip-unless + (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sudoedit-p))) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name nil quoted))) @@ -2934,15 +3325,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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'. 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))) + ;; Skip the test, if the remote handler is not able to set + ;; the correct time. + (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". - (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) - (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) + (unless (tramp-compat-time-equal-p + (nth 5 (file-attributes tmp-name1)) tramp-time-dont-know) + (should + (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) (write-region "bla" nil tmp-name2) (should (file-exists-p tmp-name2)) (should (file-newer-than-file-p tmp-name2 tmp-name1)) @@ -2959,7 +3350,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn @@ -2968,9 +3359,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-temp-buffer (insert-file-contents tmp-name) (should (verify-visited-file-modtime)) - (set-visited-file-modtime '(0 1)) + (set-visited-file-modtime (seconds-to-time 1)) (should (verify-visited-file-modtime)) - (should (equal (visited-file-modtime) '(0 1 0 0))))) + (should (= 1 (float-time (visited-file-modtime)))) + + ;; Checks with deleted file. + (delete-file tmp-name) + (dired-uncache tmp-name) + (should (verify-visited-file-modtime)) + (set-visited-file-modtime (seconds-to-time 1)) + (should (verify-visited-file-modtime)) + (should (= 1 (float-time (visited-file-modtime)))))) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) @@ -2982,7 +3381,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (file-acl tramp-test-temporary-file-directory)) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) @@ -3060,7 +3459,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." '(nil nil nil nil)))) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) @@ -3201,6 +3600,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (when (not (memq system-type '(cygwin windows-nt))) (let ((method (file-remote-p tramp-test-temporary-file-directory 'method)) (host (file-remote-p tramp-test-temporary-file-directory 'host)) + (vec (tramp-dissect-file-name tramp-test-temporary-file-directory)) (orig-syntax tramp-syntax)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) @@ -3208,9 +3608,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unwind-protect (dolist (syntax - (if tramp--test-expensive-test + (if (tramp--test-expensive-test) (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property vec "property" nil) + (let ;; This is needed for the `simplified' syntax. ((method-marker (if (zerop (length tramp-method-regexp)) @@ -3259,7 +3663,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-change-syntax orig-syntax)))) (dolist (n-e '(nil t)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((non-essential n-e) (tmp-name (tramp--test-make-temp-name nil quoted))) @@ -3321,7 +3725,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `load'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn @@ -3346,7 +3750,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) (fnnd (file-name-nondirectory tmp-name)) (default-directory tramp-test-temporary-file-directory) @@ -3392,7 +3796,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) kill-buffer-query-functions proc) @@ -3451,7 +3855,133 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc)))))) -(ert-deftest tramp-test30-interrupt-process () +(ert-deftest tramp-test30-make-process () + "Check `make-process'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (tramp--test-emacs27-p)) + + (tramp--test-instrument-test-case 0 + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) + (let ((default-directory tramp-test-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name nil quoted)) + kill-buffer-query-functions proc) + (should-not (make-process)) + + ;; Simple process. + (unwind-protect + (with-temp-buffer + (setq proc + (make-process + :name "test1" :buffer (current-buffer) :command '("cat") + :file-handler t)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`make-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; Simple process using a file. + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (setq proc + (make-process + :name "test2" :buffer (current-buffer) + :command `("cat" ,(file-name-nondirectory tmp-name)) + :file-handler t)) + (should (processp proc)) + ;; Read output. + (with-timeout (10 (ert-fail "`make-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors + (delete-process proc) + (delete-file tmp-name))) + + ;; Process filter. + (unwind-protect + (with-temp-buffer + (setq proc + (make-process + :name "test3" :buffer (current-buffer) :command '("cat") + :filter + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`make-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; Process sentinel. + (unwind-protect + (with-temp-buffer + (setq proc + (make-process + :name "test4" :buffer (current-buffer) :command '("cat") + :sentinel + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo") + (process-send-eof proc) + (delete-process proc) + ;; Read output. + (with-timeout (10 (ert-fail "`make-process' timed out")) + (while (process-live-p proc) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "killed\n"))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; Process with stderr. + (let ((stderr (generate-new-buffer (generate-new-buffer-name "stderr")))) + (unwind-protect + (with-temp-buffer + (setq proc + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/") + :stderr stderr + :file-handler t)) + (should (processp proc)) + ;; Read stderr. + (with-current-buffer stderr + (with-timeout (10 (ert-fail "`make-process' timed out")) + (while (= (point-min) (point-max)) + (accept-process-output proc 0.1))) + (should + (string-equal (buffer-string) "cat: /: Is a directory\n")))) + + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (kill-buffer stderr)))))))) + +(ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3478,13 +4008,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))))) -(ert-deftest tramp-test31-shell-command () +(ert-deftest tramp-test32-shell-command () "Check `shell-command'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) (default-directory tramp-test-temporary-file-directory) ;; Suppress nasty messages. @@ -3582,7 +4112,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-substring-no-properties (point-min) (point-max)))) ;; This test is inspired by Bug#23952. -(ert-deftest tramp-test32-environment-variables () +(ert-deftest tramp-test33-environment-variables () "Check that remote processes set / unset environment variables properly." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3660,7 +4190,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (funcall this-shell-command-to-string "set"))))))))) ;; This test is inspired by Bug#27009. -(ert-deftest tramp-test32-environment-variables-and-port-numbers () +(ert-deftest tramp-test33-environment-variables-and-port-numbers () "Check that two connections with separate ports are different." (skip-unless (tramp--test-enabled)) ;; We test it only for the mock-up connection; otherwise there might @@ -3696,7 +4226,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-cleanup-connection (tramp-dissect-file-name dir))))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test33-explicit-shell-file-name () +(ert-deftest tramp-test34-explicit-shell-file-name () "Check that connection-local `explicit-shell-file-name' is set." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3740,13 +4270,121 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (put 'explicit-shell-file-name 'permanent-local nil) (kill-buffer "*shell*")))) -(ert-deftest tramp-test34-vc-registered () +;; `exec-path' was introduced in Emacs 27.1. `executable-find' has +;; changed the number of parameters, so we use `apply' for older +;; Emacsen. +(ert-deftest tramp-test35-exec-path () + "Check `exec-path' and `executable-find'." + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Since Emacs 27.1. + (skip-unless (fboundp 'exec-path)) + + (let ((tmp-name (tramp--test-make-temp-name)) + (default-directory tramp-test-temporary-file-directory)) + (unwind-protect + (progn + (should (consp (with-no-warnings (exec-path)))) + ;; Last element is the `exec-directory'. + (should + (string-equal + (car (last (with-no-warnings (exec-path)))) + (file-remote-p default-directory 'localname))) + ;; The shell "sh" shall always exist. + (should (apply 'executable-find '("sh" remote))) + ;; Since the last element in `exec-path' is the current + ;; directory, an executable file in that directory will be + ;; found. + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (set-file-modes tmp-name #o777) + (should (file-executable-p tmp-name)) + (should + (string-equal + (apply + 'executable-find `(,(file-name-nondirectory tmp-name) remote)) + (file-remote-p tmp-name 'localname))) + (should-not + (apply + 'executable-find + `(,(concat (file-name-nondirectory tmp-name) "foo") remote)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name))))) + +;; This test is inspired by Bug#33781. +;; `exec-path' was introduced in Emacs 27.1. `executable-find' has +;; changed the number of parameters, so we use `apply' for older +;; Emacsen. +(ert-deftest tramp-test35-remote-path () + "Check loooong `tramp-remote-path'." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + ;; Since Emacs 27.1. + (skip-unless (fboundp 'exec-path)) + + (let* ((tmp-name (tramp--test-make-temp-name)) + (default-directory tramp-test-temporary-file-directory) + (orig-exec-path (exec-path)) + (tramp-remote-path tramp-remote-path) + (orig-tramp-remote-path tramp-remote-path)) + (unwind-protect + (progn + ;; Non existing directories are removed. + (setq tramp-remote-path + (cons (file-remote-p tmp-name 'localname) tramp-remote-path)) + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + 'keep-debug 'keep-password) + (should (equal (with-no-warnings (exec-path)) orig-exec-path)) + (setq tramp-remote-path orig-tramp-remote-path) + + ;; Double entries are removed. + (setq tramp-remote-path (append '("/" "/") tramp-remote-path)) + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + 'keep-debug 'keep-password) + (should + (equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path))) + (setq tramp-remote-path orig-tramp-remote-path) + + ;; We make a super long `tramp-remote-path'. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (while (< (length (mapconcat 'identity orig-exec-path ":")) 5000) + (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) + (should (file-directory-p dir)) + (setq tramp-remote-path + (cons (file-remote-p dir 'localname) tramp-remote-path) + orig-exec-path + (cons (file-remote-p dir 'localname) orig-exec-path)))) + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + 'keep-debug 'keep-password) + (should (equal (with-no-warnings (exec-path)) orig-exec-path)) + (should + (string-equal + ;; Ignore trailing newline. + (substring (shell-command-to-string "echo $PATH") nil -1) + ;; The last element of `exec-path' is `exec-directory'. + (mapconcat 'identity (butlast orig-exec-path) ":"))) + ;; The shell "sh" shall always exist. + (should (apply 'executable-find '("sh" remote)))) + + ;; Cleanup. + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + 'keep-debug 'keep-password) + (setq tramp-remote-path orig-tramp-remote-path) + (ignore-errors (delete-directory tmp-name 'recursive))))) + +(ert-deftest tramp-test36-vc-registered () "Check `vc-registered'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((default-directory tramp-test-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo" tmp-name1)) @@ -3810,11 +4448,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -(ert-deftest tramp-test35-make-auto-save-file-name () +(ert-deftest tramp-test37-make-auto-save-file-name () "Check `make-auto-save-file-name'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted))) @@ -3901,11 +4539,11 @@ 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-test36-find-backup-file-name () +(ert-deftest tramp-test38-find-backup-file-name () "Check `find-backup-file-name'." (skip-unless (tramp--test-enabled)) - (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) ;; These settings are not used by Tramp, so we ignore them. @@ -4012,7 +4650,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-directory tmp-name2 'recursive)))))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test37-make-nearby-temp-file () +(ert-deftest tramp-test39-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) ;; Since Emacs 26.1. @@ -4104,6 +4742,16 @@ This does not support external Emacs calls." (string-equal "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-nextcloud-p () + "Check, whether the nextcloud method is used." + (string-equal + "nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method))) + +(defun tramp--test-rclone-p () + "Check, whether the remote host is offered by rclone. +This requires restrictions of file name syntax." + (tramp-rclone-file-name-p tramp-test-temporary-file-directory)) + (defun tramp--test-rsync-p () "Check, whether the rsync method is used. This does not support special file names." @@ -4116,6 +4764,10 @@ This does not support special file names." (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) 'tramp-sh-file-name-handler)) +(defun tramp--test-sudoedit-p () + "Check, whether the sudoedit method is used." + (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory)) + (defun tramp--test-windows-nt () "Check, whether the locale host runs MS Windows." (eq system-type 'windows-nt)) @@ -4142,7 +4794,7 @@ This requires restrictions of file name syntax." (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. - (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs27-p)) + (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, ;; because it could be located on a symlinked directory. This @@ -4275,9 +4927,10 @@ This requires restrictions of file name syntax." (should-not (file-exists-p file1)))) ;; Check, that environment variables are set correctly. - (when (and tramp--test-expensive-test (tramp--test-sh-p)) + (when (and (tramp--test-expensive-test) (tramp--test-sh-p)) (dolist (elt files) (let ((envvar (concat "VAR_" (upcase (md5 elt)))) + (elt (encode-coding-string elt coding-system-for-read)) (default-directory tramp-test-temporary-file-directory) (process-environment process-environment)) (setenv envvar elt) @@ -4299,50 +4952,60 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test38-special-characters*'." + "Perform the test in `tramp-test40-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 ;; interpreted as a path separator, preventing "\t" from being ;; expanded to <TAB>. - (tramp--test-check-files - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "foo bar baz" - (if (or (tramp--test-adb-p) - (tramp--test-docker-p) - (eq system-type 'cygwin)) - " foo bar baz " - " foo\tbar baz\t")) - "$foo$bar$$baz$" - "-foo-bar-baz-" - "%foo%bar%baz%" - "&foo&bar&baz&" - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-windows-nt-or-smb-p)) - "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-windows-nt-or-smb-p)) - "*foo*bar*baz*") - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "'foo'bar'baz'" - "'foo\"bar'baz\"") - "#foo~bar#baz~" - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "!foo!bar!baz!" - "!foo|bar!baz|") - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - ";foo;bar;baz;" - ":foo;bar:baz;") - (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "<foo>bar<baz>") - "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") - "{foo}bar{baz}")) + (let ((files + (list + (if (or (tramp--test-gvfs-p) + (tramp--test-rclone-p) + (tramp--test-sudoedit-p) + (tramp--test-windows-nt-or-smb-p)) + "foo bar baz" + (if (or (tramp--test-adb-p) + (tramp--test-docker-p) + (eq system-type 'cygwin)) + " foo bar baz " + " foo\tbar baz\t")) + "$foo$bar$$baz$" + "-foo-bar-baz-" + "%foo%bar%baz%" + "&foo&bar&baz&" + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-windows-nt-or-smb-p)) + "?foo?bar?baz?") + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-windows-nt-or-smb-p)) + "*foo*bar*baz*") + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "'foo'bar'baz'" + "'foo\"bar'baz\"") + "#foo~bar#baz~" + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "!foo!bar!baz!" + "!foo|bar!baz|") + (if (or (tramp--test-gvfs-p) + (tramp--test-rclone-p) + (tramp--test-windows-nt-or-smb-p)) + ";foo;bar;baz;" + ":foo;bar:baz;") + (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "<foo>bar<baz>") + "(foo)bar(baz)" + (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + "{foo}bar{baz}"))) + ;; Simplify test in order to speed up. + (apply 'tramp--test-check-files + (if (tramp--test-expensive-test) + files (list (mapconcat 'identity files "")))))) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test38-special-characters () +(ert-deftest tramp-test40-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) @@ -4350,7 +5013,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test38-special-characters-with-stat () +(ert-deftest tramp-test40-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) @@ -4368,7 +5031,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test38-special-characters-with-perl () +(ert-deftest tramp-test40-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) @@ -4389,7 +5052,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test38-special-characters-with-ls () +(ert-deftest tramp-test40-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) @@ -4412,7 +5075,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test39-utf8*'." + "Perform the test in `tramp-test41-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -4420,14 +5083,34 @@ Use the `ls' command." (coding-system-for-write utf8) (file-name-coding-system (coding-system-change-eol-conversion utf8 'unix))) - (tramp--test-check-files - (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") - (unless (tramp--test-hpux-p) - "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") - "银河系漫游指南系列" - "Автостопом по гала́ктике"))) - -(ert-deftest tramp-test39-utf8 () + (apply + 'tramp--test-check-files + (append + (list + (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") + (unless (tramp--test-hpux-p) + "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") + "银河系漫游指南系列" + "Автостопом по гала́ктике" + ;; Use codepoints without a name. See Bug#31272. + "bung") + + (when (tramp--test-expensive-test) + (delete-dups + (mapcar + ;; Use all available language specific snippets. Filter out + ;; strings which use unencodable characters. + (lambda (x) + (and + (stringp (setq x (eval (get-language-info (car x) 'sample-text)))) + (not (unencodable-char-position + 0 (length x) file-name-coding-system nil x)) + ;; ?\n and ?/ shouldn't be part of any file name. ?\t, + ;; ?. and ?? do not work for "smb" method. + (replace-regexp-in-string "[\t\n/.?]" "" x))) + language-info-alist))))))) + +(ert-deftest tramp-test41-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-docker-p))) @@ -4437,7 +5120,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test39-utf8-with-stat () +(ert-deftest tramp-test41-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) @@ -4457,7 +5140,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test39-utf8-with-perl () +(ert-deftest tramp-test41-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) @@ -4480,7 +5163,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test39-utf8-with-ls () +(ert-deftest tramp-test41-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) @@ -4503,7 +5186,7 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test40-file-system-info () +(ert-deftest tramp-test42-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless (tramp--test-enabled)) ;; Since Emacs 27.1. @@ -4521,22 +5204,25 @@ Use the `ls' command." (numberp (nth 2 fsi)))))) (defun tramp--test-timeout-handler () - (interactive) + "Timeout handler, reporting a failed test." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test41-asynchronous-requests () +(ert-deftest tramp-test43-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - :tags '(:expensive-test) + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) ;; This test could be blocked on hydra. So we set a timeout of 300 ;; seconds, and we send a SIGUSR1 signal after 300 seconds. + ;; This clearly doesn't work though, because the test not + ;; infrequently hangs for hours until killed by the infrastructure. (with-timeout (300 (tramp--test-timeout-handler)) (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) + (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0) (let* (;; For the watchdog. (default-directory (expand-file-name temporary-file-directory)) (watchdog @@ -4555,10 +5241,11 @@ process sentinels. They shall not disturb each other." ;; Number of asynchronous processes for test. Tests on ;; some machines handle less parallel processes. (number-proc - (or - (ignore-errors - (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))) - 10)) + (cond + ((ignore-errors + (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES")))) + ((getenv "EMACS_HYDRA_CI") 5) + (t 10))) ;; On hydra, timings are bad. (timer-repeat (cond @@ -4588,11 +5275,16 @@ process sentinels. They shall not disturb each other." (default-directory tmp-name) (file (buffer-name (nth (random (length buffers)) buffers)))) + (tramp--test-message + "Start timer %s %s" file (current-time-string)) (funcall timer-operation file) ;; Adjust timer if it takes too much time. (when (> (- (float-time) time) timer-repeat) (setq timer-repeat (* 1.5 timer-repeat)) - (setf (timer--repeat-delay timer) timer-repeat))))))) + (setf (timer--repeat-delay timer) timer-repeat) + (tramp--test-message "Increase timer %s" timer-repeat)) + (tramp--test-message + "Stop timer %s %s" file (current-time-string))))))) ;; Create temporary buffers. The number of buffers ;; corresponds to the number of processes; it could be @@ -4619,6 +5311,8 @@ process sentinels. They shall not disturb each other." (set-process-filter proc (lambda (proc string) + (tramp--test-message + "Process filter %s %s %s" proc string (current-time-string)) (with-current-buffer (process-buffer proc) (insert string)) (unless (zerop (length string)) @@ -4628,6 +5322,8 @@ process sentinels. They shall not disturb each other." (set-process-sentinel proc (lambda (proc _state) + (tramp--test-message + "Process sentinel %s %s" proc (current-time-string)) (dired-uncache (process-get proc 'foo)) (should-not (file-attributes (process-get proc 'foo))))))) @@ -4641,6 +5337,8 @@ process sentinels. They shall not disturb each other." (proc (get-buffer-process buf)) (file (process-get proc 'foo)) (count (process-get proc 'bar))) + (tramp--test-message + "Start action %d %s %s" count buf (current-time-string)) ;; Regular operation prior process action. (dired-uncache file) (if (= count 0) @@ -4651,11 +5349,15 @@ process sentinels. They shall not disturb each other." (accept-process-output proc 0.1 nil 0) ;; Give the watchdog a chance. (read-event nil nil 0.01) + (tramp--test-message + "Continue action %d %s %s" count buf (current-time-string)) ;; Regular operation post process action. (dired-uncache file) (if (= count 2) (should-not (file-attributes file)) (should (file-attributes file))) + (tramp--test-message + "Stop action %d %s %s" count buf (current-time-string)) (process-put proc 'bar (1+ count)) (unless (process-live-p proc) (setq buffers (delq buf buffers)))))) @@ -4663,6 +5365,7 @@ process sentinels. They shall not disturb each other." ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be ;; deleted. + (tramp--test-message "Check %s" (current-time-string)) (dolist (buf buffers) (with-current-buffer buf (should (string-equal (format "%s\n" buf) (buffer-string))))) @@ -4677,11 +5380,13 @@ process sentinels. They shall not disturb each other." (ignore-errors (delete-process (get-buffer-process buf))) (ignore-errors (kill-buffer buf))) (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)))))) + (ignore-errors (delete-directory tmp-name 'recursive))))))) ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test42-auto-load () +(ert-deftest tramp-test44-auto-load () "Check that Tramp autoloads properly." + (skip-unless (tramp--test-enabled)) + (let ((default-directory (expand-file-name temporary-file-directory)) (code (format @@ -4698,7 +5403,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test42-delay-load () +(ert-deftest tramp-test44-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -4731,7 +5436,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test42-recursive-load () +(ert-deftest tramp-test44-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -4755,7 +5460,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test42-remote-load-path () +(ert-deftest tramp-test44-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; The autoloaded Tramp objects are different since Emacs 26.1. We ;; cannot test older Emacsen, therefore. @@ -4784,7 +5489,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test43-unload () +(ert-deftest tramp-test45-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -4793,42 +5498,52 @@ Since it unloads Tramp, it shall be the last test to run." ;; cannot test older Emacsen, therefore. (skip-unless (tramp--test-emacs26-p)) - (when (featurep 'tramp) - (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. - (should-not (featurep 'tramp)) - (should-not (all-completions "tramp" (delq 'tramp-tests features))) - ;; `file-name-handler-alist' must be clean. - (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) - ;; There shouldn't be left a bound symbol, except buffer-local - ;; variables, and autoload functions. We do not regard our test - ;; symbols, and the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (or (and (boundp x) (null (local-variable-if-set-p x))) - (and (functionp x) (null (autoloadp (symbol-function x))))) - (string-match "^tramp" (symbol-name x)) - (not (string-match "^tramp--?test" (symbol-name x))) - (not (string-match "unload-hook$" (symbol-name x))) - (ert-fail (format "`%s' still bound" x))))) - ;; The defstruct `tramp-file-name' and all its internal functions - ;; shall be purged. - (should-not (cl--find-class 'tramp-file-name)) - (mapatoms - (lambda (x) - (and (functionp x) - (string-match "tramp-file-name" (symbol-name x)) - (ert-fail (format "Structure function `%s' still exists" x))))) - ;; There shouldn't be left a hook function containing a Tramp - ;; function. We do not regard the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (boundp x) - (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) - (not (string-match "unload-hook$" (symbol-name x))) - (consp (symbol-value x)) - (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) + ;; We have autoloaded objects from tramp.el and tramp-archive.el. + ;; In order to remove them, we first need to load both packages. + (require 'tramp) + (require 'tramp-archive) + (should (featurep 'tramp)) + (should (featurep 'tramp-archive)) + ;; This unloads also tramp-archive.el and tramp-theme.el if needed. + (unload-feature 'tramp 'force) + ;; No Tramp feature must be left. + (should-not (featurep 'tramp)) + (should-not (featurep 'tramp-archive)) + (should-not (featurep 'tramp-theme)) + (should-not + (all-completions + "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) + ;; `file-name-handler-alist' must be clean. + (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol, except buffer-local + ;; variables, and autoload functions. We do not regard our test + ;; symbols, and the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (or (and (boundp x) (null (local-variable-if-set-p x))) + (and (functionp x) (null (autoloadp (symbol-function x))))) + (string-match "^tramp" (symbol-name x)) + (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) + (not (string-match "unload-hook$" (symbol-name x))) + (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions + ;; shall be purged. + (should-not (cl--find-class 'tramp-file-name)) + (mapatoms + (lambda (x) + (and (functionp x) + (string-match "tramp-file-name" (symbol-name x)) + (ert-fail (format "Structure function `%s' still exists" x))))) + ;; There shouldn't be left a hook function containing a Tramp + ;; function. We do not regard the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (boundp x) + (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) + (not (string-match "unload-hook$" (symbol-name x))) + (consp (symbol-value x)) + (ignore-errors (all-completions "tramp" (symbol-value x))) + (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." @@ -4845,11 +5560,14 @@ Since it unloads Tramp, it shall be the last test to run." ;; * file-name-case-insensitive-p ;; * Work on skipped tests. Make a comment, when it is impossible. +;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. +;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' +;; do not work properly for `nextcloud'. ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. -;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. +;; * Fix `tramp-test31-interrupt-process', timeout doesn't work reliably. +;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. (provide 'tramp-tests) ;;; tramp-tests.el ends here |