diff options
Diffstat (limited to 'test/lisp/net/tramp-tests.el')
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 747 |
1 files changed, 567 insertions, 180 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ceda70947c8..1c7198ce560 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1,6 +1,6 @@ ;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*- -;; Copyright (C) 2013-2018 Free Software Foundation, Inc. +;; Copyright (C) 2013-2019 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> @@ -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-test42-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. @@ -57,14 +57,18 @@ (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) ;; Beautify batch mode. (when noninteractive ;; Suppress nasty messages. - (fset 'shell-command-sentinel 'ignore) + (fset #'shell-command-sentinel #'ignore) ;; We do not want to be interrupted. (eval-after-load 'tramp-gvfs '(fset 'tramp-gvfs-handler-askquestion @@ -145,7 +149,7 @@ If LOCAL is non-nil, a local file name is returned. If QUOTED is non-nil, the local part of the file name is quoted. The temporary file is not created." (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (make-temp-name "tramp-test") (if local temporary-file-directory tramp-test-temporary-file-directory)))) @@ -157,9 +161,9 @@ This shall used dynamically bound only.") (defmacro tramp--test-instrument-test-case (verbose &rest body) "Run BODY with `tramp-verbose' equal VERBOSE. -Print the content of the Tramp debug buffer, if BODY does not -eval properly in `should' or `should-not'. `should-error' is not -handled properly. BODY shall not contain a timeout." +Print the content of the Tramp connection and debug buffers, if +`tramp-verbose' is greater than 3. `should-error' is not handled +properly. BODY shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) (tramp-message-show-message t) @@ -181,7 +185,7 @@ handled properly. BODY shall not contain a timeout." "Emit a message into ERT *Messages*." (tramp--test-instrument-test-case 0 (apply - 'tramp-message + #'tramp-message (tramp-dissect-file-name tramp-test-temporary-file-directory) 0 fmt-string arguments))) @@ -233,6 +237,10 @@ handled properly. BODY shall not contain a timeout." (should (tramp-tramp-file-p "/method:[::1]:")) (should (tramp-tramp-file-p "/method:user@[::1]:")) + ;; Using an IPv4 mapped IPv6 address. + (should (tramp-tramp-file-p "/method:[::ffff:1.2.3.4]:")) + (should (tramp-tramp-file-p "/method:user@[::ffff:1.2.3.4]:")) + ;; Local file name part. (should (tramp-tramp-file-p "/method:::")) (should (tramp-tramp-file-p "/method::/:")) @@ -260,6 +268,7 @@ handled properly. BODY shall not contain a timeout." (should-not (tramp-tramp-file-p "/1.2.3.4:")) (should-not (tramp-tramp-file-p "/[]:")) (should-not (tramp-tramp-file-p "/[::1]:")) + (should-not (tramp-tramp-file-p "/[::ffff:1.2.3.4]:")) (should-not (tramp-tramp-file-p "/host:/:")) (should-not (tramp-tramp-file-p "/host1|host2:")) (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:")) @@ -308,6 +317,10 @@ handled properly. BODY shall not contain a timeout." (should (tramp-tramp-file-p "/[::1]:")) (should (tramp-tramp-file-p "/user@[::1]:")) + ;; Using an IPv4 mapped IPv6 address. + (should (tramp-tramp-file-p "/[::ffff:1.2.3.4]:")) + (should (tramp-tramp-file-p "/user@[::ffff:1.2.3.4]:")) + ;; Local file name part. (should (tramp-tramp-file-p "/host::")) (should (tramp-tramp-file-p "/host:/:")) @@ -358,6 +371,10 @@ handled properly. BODY shall not contain a timeout." (should (tramp-tramp-file-p "/[method/::1]")) (should (tramp-tramp-file-p "/[method/user@::1]")) + ;; Using an IPv4 mapped IPv6 address. + (should (tramp-tramp-file-p "/[method/::ffff:1.2.3.4]")) + (should (tramp-tramp-file-p "/[method/user@::ffff:1.2.3.4]")) + ;; Local file name part. (should (tramp-tramp-file-p "/[method/]")) (should (tramp-tramp-file-p "/[method/]/:")) @@ -399,7 +416,10 @@ handled properly. BODY shall not contain a timeout." (tramp-default-host "default-host") tramp-default-method-alist tramp-default-user-alist - tramp-default-host-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::") @@ -819,12 +839,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/method1:%u@%h" - "|method2:%u@%h" - "|method3:user3@host3:/path/to/file")) - (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" - "method1" "user3" "host3" - "method2" "user3" "host3" - "method3" "user3" "host3"))))) + "|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." @@ -834,6 +856,9 @@ handled properly. BODY shall not contain a timeout." (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 @@ -1134,12 +1159,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/%u@%h" + "|user2@host2" "|%u@%h" - "|user3@host3:/path/to/file")) - (format "/%s@%s|%s@%s|%s@%s:" - "user3" "host3" - "user3" "host3" - "user3" "host3")))) + "|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)))) @@ -1153,6 +1180,9 @@ handled properly. BODY shall not contain a timeout." 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 @@ -1780,12 +1810,14 @@ handled properly. BODY shall not contain a timeout." (file-remote-p (concat "/[method1/%u@%h" - "|method2/%u@%h" - "|method3/user3@host3]/path/to/file")) - (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" - "method1" "user3" "host3" - "method2" "user3" "host3" - "method3" "user3" "host3")))) + "|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)))) @@ -1798,17 +1830,15 @@ handled properly. BODY shall not contain a timeout." (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp")) (dolist (u '("ftp" "anonymous")) (should (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp"))) - ;; Default values in tramp-gvfs.el. - (when (and (load "tramp-gvfs" 'noerror 'nomessage) - (symbol-value 'tramp-gvfs-enabled)) - (should (string-equal (file-remote-p "/synce::" 'user) nil))) - ;; Default values in tramp-sh.el. + ;; Default values in tramp-sh.el and tramp-sudoedit.el. (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) (should (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))) - (dolist (m '("su" "sudo" "ksu")) - (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))) - (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) + (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) + (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")) + (should + (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))) + (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) (should (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) ;; Default values in tramp-smb.el. @@ -1839,12 +1869,21 @@ handled properly. BODY shall not contain a timeout." "%s|%s:foo:" (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1) m)) - :type - (if (tramp-method-out-of-band-p vec 0) 'file-error 'user-error))))) + :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. @@ -1949,6 +1988,18 @@ handled properly. BODY shall not contain a timeout." (should (string-equal (expand-file-name "/method:host:/path/../file") "/method:host:/file")) + (should + (string-equal + (expand-file-name "/method:host:/path/.") "/method:host:/path")) + (should + (string-equal + (expand-file-name "/method:host:/path/..") "/method:host:/")) + (should + (string-equal + (expand-file-name "." "/method:host:/path/") "/method:host:/path")) + (should + (string-equal + (expand-file-name "" "/method:host:/path/") "/method:host:/path")) ;; Quoting local part. (should (string-equal @@ -1962,9 +2013,9 @@ handled properly. BODY shall not contain a timeout." (expand-file-name "/method:host:/:/~/path/./file") "/method:host:/:/~/path/file"))) -;; The following test is inspired by Bug#26911. It is rather a bug in -;; `expand-file-name', and it fails for all Emacs versions. Test -;; added for later, when it is fixed. +;; The following test is inspired by Bug#26911 and Bug#34834. They +;; are rather bugs in `expand-file-name', and it fails for all Emacs +;; versions. Test added for later, when they are fixed. (ert-deftest tramp-test05-expand-file-name-relative () "Check `expand-file-name'." ;; Mark as failed until bug has been fixed. @@ -1972,7 +2023,7 @@ handled properly. BODY shall not contain a timeout." (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)) @@ -2039,7 +2090,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; We must clear `tramp-default-method'. On hydra, it is "ftp", ;; which ruins the tests. (let ((non-essential n-e) - tramp-default-method) + (tramp-default-method + (file-remote-p tramp-test-temporary-file-directory 'method))) (dolist (file `(,(format @@ -2703,7 +2755,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (format "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" (regexp-opt (directory-files tmp-name1)) - (length (directory-files tmp-name1)))))))) + (length (directory-files tmp-name1))))))) + + ;; Check error case. We do not check for the error type, + ;; because ls-lisp returns `file-error', and native Tramp + ;; returns `file-missing'. + (delete-directory tmp-name1 'recursive) + (with-temp-buffer + (should-error (insert-directory tmp-name1 nil)))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -2725,7 +2784,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (tmp-name4 (expand-file-name "bar" tmp-name2)) (tramp-test-temporary-file-directory (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) tramp-test-temporary-file-directory)) buffer) (unwind-protect @@ -2829,8 +2888,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', `file-regular-p' and -`file-ownership-preserved-p'." +This tests also `access-file', `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))) @@ -2851,6 +2910,9 @@ This tests also `file-readable-p', `file-regular-p' and attr) (unwind-protect (progn + (should-error + (access-file tmp-name1 "error") + :type tramp-file-missing) ;; `file-ownership-preserved-p' should return t for ;; non-existing files. It is implemented only in tramp-sh.el. (when (tramp--test-sh-p) @@ -2859,6 +2921,7 @@ This tests also `file-readable-p', `file-regular-p' and (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should (file-regular-p tmp-name1)) + (should-not (access-file tmp-name1 "error")) (when (tramp--test-sh-p) (should (file-ownership-preserved-p tmp-name1 'group))) @@ -2883,18 +2946,22 @@ This tests also `file-readable-p', `file-regular-p' and (should (stringp (nth 3 attr))) ;; Gid. (tramp--test-ignore-make-symbolic-link-error + (should-error + (access-file tmp-name2 "error") + :type tramp-file-missing) (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)) + (should-not (access-file tmp-name2 "error")) (when (tramp--test-sh-p) (should (file-ownership-preserved-p tmp-name2 'group))) (setq attr (file-attributes tmp-name2)) (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (car attr)) (file-remote-p (file-truename tmp-name1) 'localname))) (delete-file tmp-name2)) @@ -2926,6 +2993,7 @@ This tests also `file-readable-p', `file-regular-p' and (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should-not (file-regular-p tmp-name1)) + (should-not (access-file tmp-name1 "")) (when (tramp--test-sh-p) (should (file-ownership-preserved-p tmp-name1 'group))) (setq attr (file-attributes tmp-name1)) @@ -2936,6 +3004,13 @@ This tests also `file-readable-p', `file-regular-p' and (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) +(defsubst tramp--test-file-attributes-equal-p (attr1 attr2) + "Check, whether file attributes ATTR1 and ATTR2 are equal. +They might differ only in access time." + (setcar (nthcdr 4 attr1) tramp-time-dont-know) + (setcar (nthcdr 4 attr2) tramp-time-dont-know) + (equal attr1 attr2)) + (ert-deftest tramp-test19-directory-files-and-attributes () "Check `directory-files-and-attributes'." (skip-unless (tramp--test-enabled)) @@ -2967,16 +3042,18 @@ This tests also `file-readable-p', `file-regular-p' and 5 (file-attributes (expand-file-name (car elt) tmp-name2))) tramp-time-dont-know) (should - (equal (file-attributes (expand-file-name (car elt) tmp-name2)) - (cdr elt))))) + (tramp--test-file-attributes-equal-p + (file-attributes (expand-file-name (car elt) tmp-name2)) + (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 'full)) (dolist (elt attr) (unless (tramp-compat-time-equal-p (nth 5 (file-attributes (car elt))) tramp-time-dont-know) (should - (equal (file-attributes (car elt)) (cdr elt))))) + (tramp--test-file-attributes-equal-p + (file-attributes (car elt)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) - (should (equal (mapcar 'car attr) '("bar" "boz")))) + (should (equal (mapcar #'car attr) '("bar" "boz")))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -2985,7 +3062,7 @@ 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))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) @@ -3048,7 +3125,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) (when (tramp--test-expensive-test) @@ -3057,7 +3134,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :type 'file-already-exists)) (when (tramp--test-expensive-test) ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) (should-error (make-symbolic-link tmp-name1 tmp-name2 0) :type 'file-already-exists))) @@ -3066,14 +3143,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2)))) (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) ;; If we use the local part of `tmp-name1', it shall still work. @@ -3083,7 +3160,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name2))) ;; `tmp-name3' is a local file name. Therefore, the link @@ -3103,7 +3180,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) (file-remote-p tmp-name1 'localname)) (file-symlink-p tmp-name5))) ;; `smbclient' does not show symlinks in directories, so @@ -3130,7 +3207,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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)) + (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) (should-error (add-name-to-file tmp-name1 tmp-name2 0) :type 'file-already-exists)) @@ -3187,7 +3264,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-file tmp-name2) (make-symbolic-link (funcall - (if quoted 'tramp-compat-file-name-unquote 'identity) + (if quoted #'tramp-compat-file-name-unquote #'identity) "/penguin:motd:") tmp-name2) (should (file-symlink-p tmp-name2)) @@ -3276,7 +3353,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let* ((dir1 (directory-file-name (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (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))) @@ -3285,7 +3362,8 @@ 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 (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))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) @@ -3655,12 +3733,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (file-name-completion "a" tmp-name)) (should (equal - (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) + (file-name-completion "b" tmp-name #'file-directory-p) "boz/")) (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) (should (equal - (sort (file-name-all-completions "b" tmp-name) 'string-lessp) + (sort (file-name-all-completions "b" tmp-name) #'string-lessp) '("bold" "boz/"))) (should-not (file-name-all-completions "a" tmp-name)) ;; `completion-regexp-list' restricts the completion to @@ -3671,7 +3749,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (equal (file-name-completion "" tmp-name) "bo")) (should (equal - (sort (file-name-all-completions "" tmp-name) 'string-lessp) + (sort (file-name-all-completions "" tmp-name) #'string-lessp) '("bold" "boz/")))) ;; `file-name-completion' ignores file names that end in ;; any string in `completion-ignored-extensions'. @@ -3686,7 +3764,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `file-name-all-completions' is not affected. (should (equal - (sort (file-name-all-completions "" tmp-name) 'string-lessp) + (sort (file-name-all-completions "" tmp-name) #'string-lessp) '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) ;; Cleanup. @@ -3761,6 +3839,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) +;; Must be a command, because used as `sigusr' handler. +(defun tramp--test-timeout-handler (&rest _ignore) + "Timeout handler, reporting a failed test." + (interactive) + (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) + (ert-deftest tramp-test29-start-file-process () "Check `start-file-process'." :tags '(:expensive-test) @@ -3779,9 +3863,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (process-send-string proc "foo") (process-send-eof proc) ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) + (while (accept-process-output proc 0 nil t)))) (should (string-equal (buffer-string) "foo"))) ;; Cleanup. @@ -3797,9 +3881,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "cat" (file-name-nondirectory tmp-name))) (should (processp proc)) ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) + (while (accept-process-output proc 0 nil t)))) (should (string-equal (buffer-string) "foo"))) ;; Cleanup. @@ -3818,15 +3902,139 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (process-send-string proc "foo") (process-send-eof proc) ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 0.1))) + (while (accept-process-output proc 0 nil t)))) (should (string-equal (buffer-string) "foo"))) ;; 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)) + + (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 (tramp--test-timeout-handler)) + (while (< (- (point-max) (point-min)) (length "foo")) + (while (accept-process-output proc 0 nil t)))) + (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 (tramp--test-timeout-handler)) + (while (< (- (point-max) (point-min)) (length "foo")) + (while (accept-process-output proc 0 nil t)))) + (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 (tramp--test-timeout-handler)) + (while (< (- (point-max) (point-min)) (length "foo")) + (while (accept-process-output proc 0 nil t)))) + (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 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (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 (tramp--test-timeout-handler)) + (while (= (point-min) (point-max)) + (while (accept-process-output proc 0 nil t)))) + (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)) @@ -3845,7 +4053,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (numberp (process-get proc 'remote-pid))) (should (interrupt-process proc)) ;; Let the process accept the interrupt. - (accept-process-output proc 1 nil 0) + (while (accept-process-output proc nil nil 0)) (should-not (process-live-p proc)) ;; An interrupted process cannot be interrupted, again. (should-error (interrupt-process proc) :type 'error)) @@ -3853,11 +4061,14 @@ 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)) + ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for + ;; remote processes in Emacs. That doesn't work for tramp-adb.el. + (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) + (tramp--test-sh-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -3885,6 +4096,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name))) + ;; tramp-adb.el is not fit yet for asynchronous processes. + (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -3893,11 +4106,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) ;; Read output. - (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)) 0.1))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output + (get-buffer-process (current-buffer)) nil nil t))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while @@ -3913,8 +4124,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (ignore-errors (delete-file tmp-name)))) + ;; tramp-adb.el is not fit yet for asynchronous processes. + (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -3924,11 +4137,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (get-buffer-process (current-buffer)) (format "%s\n" (file-name-nondirectory tmp-name))) ;; Read output. - (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)) 0.1))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output + (get-buffer-process (current-buffer)) nil nil t))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while @@ -3944,20 +4155,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name)))))) + (ignore-errors (delete-file tmp-name))))))) (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer (async-shell-command command (current-buffer)) - (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) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while (accept-process-output + (get-buffer-process (current-buffer)) nil nil t))) (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)) @@ -4035,7 +4246,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 @@ -4070,12 +4281,80 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:")) (tramp-cleanup-connection (tramp-dissect-file-name dir))))) +;; Connection-local variables are enabled per default since Emacs 27.1. +(ert-deftest tramp-test34-connection-local-variables () + "Check that connection-local variables are enabled." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + ;; Since Emacs 27.1. + (skip-unless (fboundp 'with-connection-local-variables)) + + ;; `connection-local-set-profile-variables' and + ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't + ;; want to see compiler warnings for older Emacsen. + (let* ((default-directory tramp-test-temporary-file-directory) + (tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + (enable-local-variables :all) + (enable-remote-dir-locals t) + kill-buffer-query-functions + connection-local-profile-alist connection-local-criteria-alist) + (unwind-protect + (progn + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + + ;; `local-variable' is buffer-local due to explicit setting. + (with-no-warnings + (defvar-local local-variable 'buffer)) + (with-temp-buffer + (should (eq local-variable 'buffer))) + + ;; `local-variable' is connection-local due to Tramp. + (write-region "foo" nil tmp-name2) + (should (file-exists-p tmp-name2)) + (with-no-warnings + (connection-local-set-profile-variables + 'local-variable-profile + '((local-variable . connect))) + (connection-local-set-profiles + `(:application tramp + :protocol ,(file-remote-p default-directory 'method) + :user ,(file-remote-p default-directory 'user) + :machine ,(file-remote-p default-directory 'host)) + 'local-variable-profile)) + (with-current-buffer (find-file-noselect tmp-name2) + (should (eq local-variable 'connect)) + (kill-buffer (current-buffer))) + + ;; `local-variable' is dir-local due to existence of .dir-locals.el. + (write-region + "((nil . ((local-variable . dir))))" nil + (expand-file-name ".dir-locals.el" tmp-name1)) + (should (file-exists-p (expand-file-name ".dir-locals.el" tmp-name1))) + (with-current-buffer (find-file-noselect tmp-name2) + (should (eq local-variable 'dir)) + (kill-buffer (current-buffer))) + + ;; `local-variable' is file-local due to specifying as file variable. + (write-region + "-*- mode: comint; local-variable: file; -*-" nil tmp-name2) + (should (file-exists-p tmp-name2)) + (with-current-buffer (find-file-noselect tmp-name2) + (should (eq local-variable 'file)) + (kill-buffer (current-buffer)))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive))))) + ;; 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) + ;; The handling of connection-local variables has changed. Test + ;; must be reworked. + :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -4084,7 +4363,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't ;; want to see compiler warnings for older Emacsen. (let ((default-directory tramp-test-temporary-file-directory) - explicit-shell-file-name kill-buffer-query-functions) + explicit-shell-file-name kill-buffer-query-functions + connection-local-profile-alist connection-local-criteria-alist) (unwind-protect (progn ;; `shell-mode' would ruin our test, because it deletes all @@ -4094,7 +4374,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-no-warnings (connection-local-set-profile-variables 'remote-sh - '((explicit-shell-file-name . "/bin/sh") + `((explicit-shell-file-name + . ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")) (explicit-sh-args . ("-i")))) (connection-local-set-profiles `(:application tramp @@ -4102,6 +4383,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :user ,(file-remote-p default-directory 'user) :machine ,(file-remote-p default-directory 'host)) 'remote-sh)) + (put 'explicit-shell-file-name 'safe-local-variable #'identity) + (put 'explicit-sh-args 'safe-local-variable #'identity) ;; Run interactive shell. Since the default directory is ;; remote, `explicit-shell-file-name' shall be set in order @@ -4109,16 +4392,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-current-buffer (get-buffer-create "*shell*") (ignore-errors (kill-process (current-buffer))) (should-not explicit-shell-file-name) - (call-interactively 'shell) + (call-interactively #'shell) (should explicit-shell-file-name))) + ;; Cleanup. (put 'explicit-shell-file-name 'permanent-local nil) (kill-buffer "*shell*")))) ;; `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-test34-exec-path () +(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))) @@ -4136,7 +4420,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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))) + (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. @@ -4147,17 +4431,83 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (apply - 'executable-find `(,(file-name-nondirectory tmp-name) remote)) + #'executable-find `(,(file-name-nondirectory tmp-name) remote)) (file-remote-p tmp-name 'localname))) (should-not (apply - 'executable-find + #'executable-find `(,(concat (file-name-nondirectory tmp-name) "foo") remote)))) ;; Cleanup. (ignore-errors (delete-file tmp-name))))) -(ert-deftest tramp-test35-vc-registered () +;; 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 (with-no-warnings (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)) @@ -4227,7 +4577,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -(ert-deftest tramp-test36-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)) @@ -4264,7 +4614,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (string-equal (make-auto-save-file-name) (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "#%s#" (file-name-nondirectory tmp-name1)) tramp-test-temporary-file-directory)))))) @@ -4318,7 +4668,7 @@ 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-test37-find-backup-file-name () +(ert-deftest tramp-test38-find-backup-file-name () "Check `find-backup-file-name'." (skip-unless (tramp--test-enabled)) @@ -4338,7 +4688,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (find-backup-file-name tmp-name1) (list (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" (file-name-nondirectory tmp-name1)) tramp-test-temporary-file-directory))))))) @@ -4352,7 +4702,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (find-backup-file-name tmp-name1) (list (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" @@ -4380,7 +4730,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (find-backup-file-name tmp-name1) (list (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" @@ -4409,7 +4759,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (find-backup-file-name tmp-name1) (list (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" @@ -4429,7 +4779,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-test38-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. @@ -4526,6 +4876,11 @@ This does not support external Emacs calls." (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." @@ -4538,6 +4893,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)) @@ -4609,7 +4968,7 @@ This requires restrictions of file name syntax." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (car (file-attributes file3))) (file-remote-p (file-truename file1) 'localname))) ;; Check file contents. @@ -4621,10 +4980,10 @@ This requires restrictions of file name syntax." ;; Check file names. (should (equal (directory-files tmp-name1 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) + (sort (copy-sequence files) #'string-lessp))) (should (equal (directory-files tmp-name2 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) + (sort (copy-sequence files) #'string-lessp))) ;; `substitute-in-file-name' could return different ;; values. For `adb', there could be strange file @@ -4684,7 +5043,7 @@ This requires restrictions of file name syntax." (should (string-equal (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) + (if quoted #'tramp-compat-file-name-quote #'identity) (cadr (car (directory-files-and-attributes file1 nil (regexp-quote elt1))))) (file-remote-p (file-truename file2) 'localname))) @@ -4722,7 +5081,7 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test39-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 @@ -4730,7 +5089,10 @@ This requires restrictions of file name syntax." ;; expanded to <TAB>. (let ((files (list - (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + (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) @@ -4756,7 +5118,9 @@ This requires restrictions of file name syntax." (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)) + (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)) @@ -4765,12 +5129,12 @@ This requires restrictions of file name syntax." (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 + (apply #'tramp--test-check-files (if (tramp--test-expensive-test) - files (list (mapconcat 'identity files "")))))) + files (list (mapconcat #'identity files "")))))) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test39-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))) @@ -4778,7 +5142,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test39-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) @@ -4796,7 +5160,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test39-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) @@ -4817,7 +5181,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test39-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) @@ -4840,7 +5204,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test40-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)) @@ -4849,7 +5213,7 @@ Use the `ls' command." (file-name-coding-system (coding-system-change-eol-conversion utf8 'unix))) (apply - 'tramp--test-check-files + #'tramp--test-check-files (append (list (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") @@ -4875,7 +5239,7 @@ Use the `ls' command." (replace-regexp-in-string "[\t\n/.?]" "" x))) language-info-alist))))))) -(ert-deftest tramp-test40-utf8 () +(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))) @@ -4885,7 +5249,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test40-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) @@ -4905,7 +5269,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test40-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) @@ -4928,7 +5292,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test40-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) @@ -4951,7 +5315,7 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test41-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. @@ -4968,32 +5332,41 @@ Use the `ls' command." (numberp (nth 1 fsi)) (numberp (nth 2 fsi)))))) -(defun tramp--test-timeout-handler () - "Timeout handler, reporting a failed test." - (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) +;; `tramp-test43-asynchronous-requests' could be blocked. So we set a +;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300 +;; seconds. Similar check is performed in the timer function. +(defconst tramp--test-asynchronous-requests-timeout 300 + "Timeout for `tramp-test43-asynchronous-requests'.") ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test42-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." + ;; The test fails from time to time, w/o a reproducible pattern. So + ;; we mark it as unstable. :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + ;; This test is sensible wrt to other running tests. Let it work + ;; only if it is the only selected test. + ;; FIXME: There must be a better solution. + (skip-unless + (= 1 (length + (ert-select-tests (ert--stats-selector ert--current-run-stats) t)))) - ;; 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) + (with-timeout + (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) + (define-key special-event-map [sigusr1] #'tramp--test-timeout-handler) (let* (;; For the watchdog. (default-directory (expand-file-name temporary-file-directory)) + (shell-file-name "/bin/sh") (watchdog - (start-process - "*watchdog*" nil shell-file-name shell-command-switch - (format "sleep 300; kill -USR1 %d" (emacs-pid)))) + (start-process-shell-command + "*watchdog*" nil + (format + "sleep %d; kill -USR1 %d" + tramp--test-asynchronous-requests-timeout (emacs-pid)))) (tmp-name (tramp--test-make-temp-name)) (default-directory tmp-name) ;; Do not cache Tramp properties. @@ -5019,8 +5392,11 @@ process sentinels. They shall not disturb each other." ;; We must distinguish due to performance reasons. (timer-operation (cond - ((tramp--test-mock-p) 'vc-registered) - (t 'file-attributes))) + ((tramp--test-mock-p) #'vc-registered) + (t #'file-attributes))) + ;; This is when all timers start. We check inside the + ;; timer function, that we don't exceed timeout. + (timer-start (current-time)) timer buffers kill-buffer-query-functions) (unwind-protect @@ -5035,6 +5411,9 @@ process sentinels. They shall not disturb each other." (run-at-time 0 timer-repeat (lambda () + (when (> (- (time-to-seconds) (time-to-seconds timer-start)) + tramp--test-asynchronous-requests-timeout) + (tramp--test-timeout-handler)) (when buffers (let ((time (float-time)) (default-directory tmp-name) @@ -5044,12 +5423,13 @@ process sentinels. They shall not disturb each other." "Start timer %s %s" file (current-time-string)) (funcall timer-operation file) ;; Adjust timer if it takes too much time. + (tramp--test-message + "Stop timer %s %s" file (current-time-string)) (when (> (- (float-time) time) timer-repeat) (setq timer-repeat (* 1.5 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))))))) + (tramp--test-message + "Increase timer %s" timer-repeat))))))) ;; Create temporary buffers. The number of buffers ;; corresponds to the number of processes; it could be @@ -5065,9 +5445,9 @@ process sentinels. They shall not disturb each other." (start-file-process-shell-command (buffer-name buf) buf (concat - "(read line && echo $line >$line);" - "(read line && cat $line);" - "(read line && rm $line)"))) + "(read line && echo $line >$line && echo $line);" + "(read line && cat $line);" + "(read line && rm -f $line)"))) (file (expand-file-name (buffer-name buf)))) ;; Remember the file name. Add counter. (process-put proc 'foo file) @@ -5083,17 +5463,16 @@ process sentinels. They shall not disturb each other." (unless (zerop (length string)) (dired-uncache (process-get proc 'foo)) (should (file-attributes (process-get proc 'foo)))))) - ;; Add process sentinel. + ;; Add process sentinel. It shall not perform remote + ;; operations, triggering Tramp processes. This blocks. (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))))))) + "Process sentinel %s %s" proc (current-time-string)))))) - ;; Send a string. Use a random order of the buffers. Mix - ;; with regular operation. + ;; Send a string to the processes. Use a random order of + ;; the buffers. Mix with regular operation. (let ((buffers (copy-sequence buffers))) (while buffers ;; Activate timer. @@ -5111,7 +5490,7 @@ process sentinels. They shall not disturb each other." (should (file-attributes file))) ;; Send string to process. (process-send-string proc (format "%s\n" (buffer-name buf))) - (accept-process-output proc 0.1 nil 0) + (while (accept-process-output proc 0 nil 0)) ;; Give the watchdog a chance. (read-event nil nil 0.01) (tramp--test-message @@ -5133,22 +5512,23 @@ process sentinels. They shall not disturb each other." (tramp--test-message "Check %s" (current-time-string)) (dolist (buf buffers) (with-current-buffer buf - (should (string-equal (format "%s\n" buf) (buffer-string))))) + (should + (string-equal (format "%s\n%s\n" buf buf) (buffer-string))))) (should-not (directory-files tmp-name nil directory-files-no-dot-files-regexp))) ;; Cleanup. - (define-key special-event-map [sigusr1] 'ignore) + (define-key special-event-map [sigusr1] #'ignore) (ignore-errors (quit-process watchdog)) (dolist (buf buffers) (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-test43-auto-load () +(ert-deftest tramp-test44-auto-load () "Check that Tramp autoloads properly." (skip-unless (tramp--test-enabled)) @@ -5165,10 +5545,10 @@ process sentinels. They shall not disturb each other." "%s -batch -Q -L %s --eval %s" (shell-quote-argument (expand-file-name invocation-name invocation-directory)) - (mapconcat 'shell-quote-argument load-path " -L ") + (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test43-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. @@ -5198,10 +5578,10 @@ process sentinels. They shall not disturb each other." "%s -batch -Q -L %s --eval %s" (shell-quote-argument (expand-file-name invocation-name invocation-directory)) - (mapconcat 'shell-quote-argument load-path " -L ") + (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test43-recursive-load () +(ert-deftest tramp-test44-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -5222,10 +5602,10 @@ process sentinels. They shall not disturb each other." "%s -batch -Q -L %s --eval %s" (shell-quote-argument (expand-file-name invocation-name invocation-directory)) - (mapconcat 'shell-quote-argument load-path " -L ") + (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test43-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. @@ -5243,17 +5623,18 @@ process sentinels. They shall not disturb each other." (string-match (format "Loading %s" - (expand-file-name - "tramp-cmds" (file-name-directory (locate-library "tramp")))) + (regexp-quote + (expand-file-name + "tramp-cmds" (file-name-directory (locate-library "tramp"))))) (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" (shell-quote-argument (expand-file-name invocation-name invocation-directory)) - (mapconcat 'shell-quote-argument load-path " -L ") + (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test44-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) @@ -5278,7 +5659,7 @@ Since it unloads Tramp, it shall be the last test to run." (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))) + (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. @@ -5313,7 +5694,8 @@ Since it unloads Tramp, it shall be the last test to run." "Run all tests for \\[tramp]." (interactive "p") (funcall - (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) + (if interactive + #'ert-run-tests-interactively #'ert-run-tests-batch) "^tramp")) ;; TODO: @@ -5322,6 +5704,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * file-equal-p (partly done in `tramp-test21-file-links') ;; * file-in-directory-p ;; * file-name-case-insensitive-p +;; * tramp-set-file-uid-gid ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. @@ -5329,9 +5712,13 @@ Since it unloads Tramp, it shall be the last test to run." ;; * 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-test42-asynchronous-requests'. +;; * Fix `tramp-test29-start-file-process' and +;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). +;; * Fix `tramp-test29-start-file-process', +;; `tramp-test30-make-process' and `tramp-test32-shell-command' for +;; `adb' (see comment in `tramp-adb-send-command'). +;; * Rework `tramp-test34-explicit-shell-file-name'. +;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. (provide 'tramp-tests) ;;; tramp-tests.el ends here |