summaryrefslogtreecommitdiff
path: root/test/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/net')
-rw-r--r--test/lisp/net/mailcap-tests.el24
-rw-r--r--test/lisp/net/network-stream-tests.el20
-rw-r--r--test/lisp/net/socks-tests.el84
-rw-r--r--test/lisp/net/tramp-archive-tests.el64
-rw-r--r--test/lisp/net/tramp-tests.el936
-rw-r--r--test/lisp/net/webjump-tests.el2
6 files changed, 647 insertions, 483 deletions
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index e47ead98f42..175c3e88da9 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -537,5 +537,29 @@ help to verify the correct addition and merging of an entry."
("minor" . ((viewer . "viewer")
(edit . "edit")))))))))
+
+
+(ert-deftest mailcap-viewer-passes-test-w/o-test-returns-t ()
+ "A VIEWER-INFO without a test should return t with a valid viewer (Bug#65224)."
+
+ (should (equal t
+ (let ((mailcap-viewer-test-cache)
+ (viewer-info
+ (list (cons 'viewer "viewer-w/o-test"))))
+ (mailcap-viewer-passes-test viewer-info nil))))
+
+ (should (equal '(t t nil t)
+ (let ((mailcap-viewer-test-cache)
+ (viewer-infos
+ (list
+ (list (cons 'viewer "viewer-w/o-test"))
+ (list (cons 'viewer "viewer-w/o-test"))
+ (list (cons 'viewer "viewer-w/nil-test")
+ (cons 'test nil))
+ (list (cons 'viewer "viewer-w/o-test"))
+ )))
+ (mapcar (lambda (vi)
+ (mailcap-viewer-passes-test vi nil))
+ viewer-infos)))))
;;; mailcap-tests.el ends here
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 0fd9549c305..8b1ae398930 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -236,7 +236,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect)))
+ (skip-when (eq (process-status proc) 'connect))
(with-current-buffer (process-buffer proc)
(process-send-string proc "echo foo")
(sleep-for 0.1)
@@ -323,7 +323,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -336,7 +336,7 @@
(ert-deftest connect-to-tls-ipv6-nowait ()
(skip-unless (executable-find "gnutls-serv"))
(skip-unless (gnutls-available-p))
- (skip-unless (not (eq system-type 'windows-nt)))
+ (skip-when (eq system-type 'windows-nt))
(skip-unless (featurep 'make-network-process '(:family ipv6)))
(let ((server (make-tls-server 44333))
(times 0)
@@ -368,7 +368,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -403,7 +403,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -446,7 +446,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -484,7 +484,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -523,7 +523,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -673,7 +673,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -712,7 +712,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 958e2ff44a8..1a4bac37bf9 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -63,21 +63,21 @@
(process-put proc 'socks-state socks-state-waiting)
(process-put proc 'socks-server-protocol 4)
(ert-info ("Receive initial incomplete segment")
- (socks-filter proc (concat [0 90 0 0 93 184 216]))
- ;; From example.com: OK status ^ ^ msg start
+ (socks-filter proc (unibyte-string 0 90 0 0 93 184 216))
+ ;; From example.com: OK status ^ ^ msg start
(ert-info ("State still set to waiting")
(should (eq (process-get proc 'socks-state) socks-state-waiting)))
(ert-info ("Response field is nil because processing incomplete")
(should-not (process-get proc 'socks-response)))
(ert-info ("Scratch field holds stashed partial payload")
- (should (string= (concat [0 90 0 0 93 184 216])
+ (should (string= (unibyte-string 0 90 0 0 93 184 216)
(process-get proc 'socks-scratch)))))
(ert-info ("Last part arrives")
(socks-filter proc "\42") ; ?\" 34
(ert-info ("State transitions to complete (length check passes)")
(should (eq (process-get proc 'socks-state) socks-state-connected)))
(ert-info ("Scratch and response fields hold stash w. last chunk")
- (should (string= (concat [0 90 0 0 93 184 216 34])
+ (should (string= (unibyte-string 0 90 0 0 93 184 216 34)
(process-get proc 'socks-response)))
(should (string= (process-get proc 'socks-response)
(process-get proc 'socks-scratch)))))
@@ -133,17 +133,19 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(defun socks-tests-canned-server-create ()
"Create and return a fake SOCKS server."
(let* ((port (nth 2 socks-server))
- (name (format "socks-server:%d" port))
+ (name (format "socks-server:%s"
+ (if (numberp port) port (ert-test-name (ert-running-test)))))
(pats socks-tests-canned-server-patterns)
(filt (lambda (proc line)
(pcase-let ((`(,pat . ,resp) (pop pats)))
(unless (or (and (vectorp pat) (equal pat (vconcat line)))
- (string-match-p pat line))
+ (and (stringp pat) (string-match-p pat line)))
(error "Unknown request: %s" line))
+ (setq resp (apply #'unibyte-string (append resp nil)))
(let ((print-escape-control-characters t))
(message "[%s] <- %s" name (prin1-to-string line))
(message "[%s] -> %s" name (prin1-to-string resp)))
- (process-send-string proc (concat resp)))))
+ (process-send-string proc resp))))
(serv (make-network-process :server 1
:buffer (get-buffer-create name)
:filter filt
@@ -151,8 +153,10 @@ Vectors must match verbatim. Strings are considered regex patterns.")
:family 'ipv4
:host 'local
:coding 'binary
- :service port)))
+ :service (or port t))))
(set-process-query-on-exit-flag serv nil)
+ (unless (numberp (nth 2 socks-server))
+ (setf (nth 2 socks-server) (process-contact serv :service)))
serv))
(defvar socks-tests--hello-world-http-request-pattern
@@ -161,9 +165,9 @@ Vectors must match verbatim. Strings are considered regex patterns.")
"Content-Length: 13\r\n\r\n"
"Hello World!\n")))
-(defun socks-tests-perform-hello-world-http-request ()
+(defun socks-tests-perform-hello-world-http-request (&optional method)
"Start canned server, validate hello-world response, and finalize."
- (let* ((url-gateway-method 'socks)
+ (let* ((url-gateway-method (or method 'socks))
(url (url-generic-parse-url "http://example.com"))
(server (socks-tests-canned-server-create))
;;
@@ -191,8 +195,9 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(ert-deftest socks-tests-v4-basic ()
"Show correct preparation of SOCKS4 connect command (Bug#46342)."
- (let ((socks-server '("server" "127.0.0.1" 10079 4))
+ (let ((socks-server '("server" "127.0.0.1" t 4))
(url-user-agent "Test/4-basic")
+ (socks-username "foo")
(socks-tests-canned-server-patterns
`(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
,socks-tests--hello-world-http-request-pattern))
@@ -201,11 +206,35 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(cl-letf (((symbol-function 'socks-nslookup-host)
(lambda (host)
(should (equal host "example.com"))
- (list 93 184 216 34)))
- ((symbol-function 'user-full-name)
- (lambda (&optional _) "foo")))
+ (list 93 184 216 34))))
(socks-tests-perform-hello-world-http-request)))))
+(ert-deftest socks-tests-v4a-basic ()
+ "Show correct preparation of SOCKS4a connect command."
+ (let ((socks-server '("server" "127.0.0.1" t 4a))
+ (socks-username "foo")
+ (url-user-agent "Test/4a-basic")
+ (socks-tests-canned-server-patterns
+ `(([4 1 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+ . [0 90 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS4A")
+ (socks-tests-perform-hello-world-http-request))))
+
+(ert-deftest socks-tests-v4a-error ()
+ "Show error signaled when destination address rejected."
+ (let ((socks-server '("server" "127.0.0.1" t 4a))
+ (url-user-agent "Test/4a-basic")
+ (socks-username "")
+ (socks-tests-canned-server-patterns
+ `(([4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+ . [0 91 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS4A")
+ (let ((err (should-error
+ (socks-tests-perform-hello-world-http-request))))
+ (should (equal err '(error "SOCKS: Rejected or failed")))))))
+
;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate
;; against curl 7.71 with the following options:
;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
@@ -213,7 +242,7 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(ert-deftest socks-tests-v5-auth-user-pass ()
"Verify correct handling of SOCKS5 user/pass authentication."
(should (assq 2 socks-authentication-methods))
- (let ((socks-server '("server" "127.0.0.1" 10080 5))
+ (let ((socks-server '("server" "127.0.0.1" t 5))
(socks-username "foo")
(socks-password "bar")
(url-user-agent "Test/auth-user-pass")
@@ -247,7 +276,7 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(ert-deftest socks-tests-v5-auth-user-pass-blank ()
"Verify correct SOCKS5 user/pass authentication with empty pass."
(should (assq 2 socks-authentication-methods))
- (let ((socks-server '("server" "127.0.0.1" 10081 5))
+ (let ((socks-server '("server" "127.0.0.1" t 5))
(socks-username "foo") ; defaults to (user-login-name)
(socks-password "") ; simulate user hitting enter when prompted
(url-user-agent "Test/auth-user-pass-blank")
@@ -264,9 +293,9 @@ Vectors must match verbatim. Strings are considered regex patterns.")
;; against curl 7.71 with the following options:
;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
-(ert-deftest socks-tests-v5-auth-none ()
+(defun socks-tests-v5-auth-none (method)
"Verify correct handling of SOCKS5 when auth method 0 requested."
- (let ((socks-server '("server" "127.0.0.1" 10082 5))
+ (let ((socks-server '("server" "127.0.0.1" t 5))
(socks-authentication-methods (append socks-authentication-methods
nil))
(url-user-agent "Test/auth-none")
@@ -278,7 +307,24 @@ Vectors must match verbatim. Strings are considered regex patterns.")
(socks-unregister-authentication-method 2)
(should-not (assq 2 socks-authentication-methods))
(ert-info ("Make HTTP request over SOCKS5 with no auth method")
- (socks-tests-perform-hello-world-http-request)))
+ (socks-tests-perform-hello-world-http-request method)))
(should (assq 2 socks-authentication-methods)))
+(ert-deftest socks-tests-v5-auth-none ()
+ (socks-tests-v5-auth-none 'socks))
+
+;; This simulates the top-level advice around `open-network-stream'
+;; that's applied when loading the library with a non-nil
+;; `socks-override-functions'.
+(ert-deftest socks-override-functions ()
+ (should-not socks-override-functions)
+ (should-not (advice-member-p #'socks--open-network-stream
+ 'open-network-stream))
+ (advice-add 'open-network-stream :around #'socks--open-network-stream)
+ (unwind-protect (let ((socks-override-functions t))
+ (socks-tests-v5-auth-none 'native))
+ (advice-remove 'open-network-stream #'socks--open-network-stream))
+ (should-not (advice-member-p #'socks--open-network-stream
+ 'open-network-stream)))
+
;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index a23f72635fe..9500ce0efca 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -121,12 +121,6 @@ the origin of the temporary TMPFILE, have no write permissions."
(directory-files tmpfile 'full directory-files-no-dot-files-regexp))
(delete-directory tmpfile)))
-(defun tramp-archive--test-emacs27-p ()
- "Check for Emacs version >= 27.1.
-Some semantics has been changed for there, without new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 27))
-
(defun tramp-archive--test-emacs28-p ()
"Check for Emacs version >= 28.1.
Some semantics has been changed for there, without new functions or
@@ -621,16 +615,13 @@ This checks also `file-name-as-directory', `file-name-directory',
(with-temp-buffer
(insert-directory tramp-archive-test-archive nil)
(goto-char (point-min))
- (should
- (looking-at-p
- (tramp-compat-rx (literal tramp-archive-test-archive)))))
+ (should (looking-at-p (rx (literal tramp-archive-test-archive)))))
(with-temp-buffer
(insert-directory tramp-archive-test-archive "-al")
(goto-char (point-min))
(should
(looking-at-p
- (tramp-compat-rx
- bol (+ nonl) blank (literal tramp-archive-test-archive) eol))))
+ (rx bol (+ nonl) blank (literal tramp-archive-test-archive) eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tramp-archive-test-archive)
@@ -886,12 +877,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(ert-deftest tramp-archive-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless tramp-archive-enabled)
- ;; Since Emacs 27.1.
- (skip-unless (fboundp 'file-system-info))
- ;; `file-system-info' exists since Emacs 27. We don't want to see
- ;; compiler warnings for older Emacsen.
- (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive))))
+ (let ((fsi (file-system-info tramp-archive-test-archive)))
(skip-unless fsi)
(should (and (consp fsi)
(tramp-compat-length= fsi 3)
@@ -900,12 +887,29 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(zerop (nth 1 fsi))
(zerop (nth 2 fsi))))))
-(ert-deftest tramp-archive-test47-auto-load ()
+;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1.
+(ert-deftest tramp-archive-test44-user-group-ids ()
+ "Check results of user/group functions.
+`file-user-uid' and `file-group-gid' should return proper values."
+ (skip-unless tramp-archive-enabled)
+ (skip-unless (and (fboundp 'file-user-uid)
+ (fboundp 'file-group-gid)))
+
+ ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1.
+ ;; We don't want to see compiler warnings for older Emacsen.
+ (let* ((default-directory tramp-archive-test-archive)
+ (uid (with-no-warnings (file-user-uid)))
+ (gid (with-no-warnings (file-group-gid))))
+ (should (integerp uid))
+ (should (integerp gid))
+ (let ((default-directory tramp-archive-test-file-archive))
+ (should (equal uid (with-no-warnings (file-user-uid))))
+ (should (equal gid (with-no-warnings (file-group-gid)))))))
+
+(ert-deftest tramp-archive-test48-auto-load ()
"Check that `tramp-archive' autoloads properly."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
- ;; Autoloading tramp-archive works since Emacs 27.1.
- (skip-unless (tramp-archive--test-emacs27-p))
;; tramp-archive is neither loaded at Emacs startup, nor when
;; loading a file like "/mock::foo" (which loads Tramp).
@@ -931,7 +935,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
(should
(string-match
- (tramp-compat-rx
+ (rx
"tramp-archive loaded: "
(literal (symbol-name
(tramp-archive-file-name-p default-directory)))
@@ -950,12 +954,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(format "(setq tramp-archive-enabled %s)" enabled))
(shell-quote-argument (format code file)))))))))))
-(ert-deftest tramp-archive-test47-delay-load ()
+(ert-deftest tramp-archive-test48-delay-load ()
"Check that `tramp-archive' is loaded lazily, only when needed."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
- ;; Autoloading tramp-archive works since Emacs 27.1.
- (skip-unless (tramp-archive--test-emacs27-p))
;; tramp-archive is neither loaded at Emacs startup, nor when
;; loading a file like "/foo.tar". It is loaded only when
@@ -976,7 +978,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(dolist (tae '(t nil))
(should
(string-match
- (tramp-compat-rx
+ (rx
"tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: " (literal (symbol-name tae)))
@@ -991,6 +993,20 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
code tae tramp-archive-test-file-archive
(concat tramp-archive-test-archive "foo"))))))))))
+(ert-deftest tramp-archive-test49-without-remote-files ()
+ "Check that Tramp can be suppressed."
+ (skip-unless tramp-archive-enabled)
+
+ (should (file-exists-p tramp-archive-test-archive))
+ (should-not (without-remote-files (file-exists-p tramp-archive-test-archive)))
+ (should (file-exists-p tramp-archive-test-archive))
+
+ (inhibit-remote-files)
+ (should-not (file-exists-p tramp-archive-test-archive))
+ (tramp-register-file-name-handlers)
+ (setq tramp-mode t)
+ (should (file-exists-p tramp-archive-test-archive)))
+
(ert-deftest tramp-archive-test99-libarchive-tests ()
"Run tests of libarchive test files."
:tags '(:expensive-test :unstable)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7854466b819..209eb1a055c 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-test44-asynchronous-requests'
+;; For slow remote connections, `tramp-test45-asynchronous-requests'
;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
;; value less than 10 could help.
@@ -72,17 +72,18 @@
(defvar tramp-persistency-file-name)
(defvar tramp-remote-path)
(defvar tramp-remote-process-environment)
+(defvar tramp-use-connection-share)
-;; Needed for Emacs 26.
-(declare-function with-connection-local-variables "files-x")
;; Needed for Emacs 27.
(defvar lock-file-name-transforms)
(defvar process-file-return-signal-string)
(defvar remote-file-name-inhibit-locks)
-(defvar shell-command-dont-erase-buffer)
-;; Needed for Emacs 28.
(defvar dired-copy-dereference)
+;; Declared in Emacs 30.
+(defvar remote-file-name-access-timeout)
+(defvar remote-file-name-inhibit-delete-by-moving-to-trash)
+
;; `ert-resource-file' was introduced in Emacs 28.1.
(unless (macrop 'ert-resource-file)
(eval-and-compile
@@ -226,7 +227,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 #'file-name-quote #'identity)
(expand-file-name
(make-temp-name "tramp-test")
(if local temporary-file-directory ert-remote-temporary-file-directory))))
@@ -262,7 +263,6 @@ is greater than 10.
`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)))
- (trace-buffer (tramp-trace-buffer-name tramp-test-vec))
(debug-ignored-errors
(append
'("^make-symbolic-link not supported$"
@@ -297,16 +297,6 @@ is greater than 10.
(tramp--test-message
"%s %f sec" ,message (float-time (time-subtract nil start))))))
-;; `always' is introduced with Emacs 28.1.
-(defalias 'tramp--test-always
- (if (fboundp 'always)
- #'always
- (lambda (&rest _arguments)
- "Do nothing and return t.
-This function accepts any number of ARGUMENTS, but ignores them.
-Also see `ignore'."
- t)))
-
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
@@ -2451,10 +2441,9 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Check `directory-abbrev-alist' abbreviation.
(let ((directory-abbrev-alist
- `((,(tramp-compat-rx bos (literal home-dir) "/foo")
- . ,(concat home-dir "/f"))
- (,(tramp-compat-rx bos (literal remote-host) "/nowhere")
- . ,(concat remote-host "/nw")))))
+ `((,(rx bos (literal home-dir) "/foo") . ,(concat home-dir "/f"))
+ (,(rx bos (literal remote-host) "/nowhere")
+ . ,(concat remote-host "/nw")))))
(should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
(concat remote-host-nohop "~/f/bar")))
(should (equal (abbreviate-file-name
@@ -2505,7 +2494,24 @@ This checks also `file-name-as-directory', `file-name-directory',
(expand-file-name
(file-name-nondirectory tmp-name) trash-directory))))
(delete-directory trash-directory 'recursive)
- (should-not (file-exists-p trash-directory)))))))
+ (should-not (file-exists-p trash-directory))))
+
+ ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash'
+ ;; prevents trashing remote files.
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t)
+ (remote-file-name-inhibit-delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ (should-not (file-exists-p tmp-name))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (delete-file tmp-name 'trash)
+ (should-not (file-exists-p tmp-name))
+ (should-not
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory tmp-name) trash-directory)))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory))))))
(ert-deftest tramp-test08-file-local-copy ()
"Check `file-local-copy'."
@@ -2549,24 +2555,57 @@ This checks also `file-name-as-directory', `file-name-directory',
(with-temp-buffer
(write-region "foo" nil tmp-name)
(let ((point (point)))
- (insert-file-contents tmp-name)
+ (should
+ (equal
+ (insert-file-contents tmp-name)
+ `(,(expand-file-name tmp-name) 3)))
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
(goto-char (1+ (point)))
(let ((point (point)))
- (insert-file-contents tmp-name)
+ (should
+ (equal
+ (insert-file-contents tmp-name)
+ `(,(expand-file-name tmp-name) 3)))
(should (string-equal (buffer-string) "ffoooo"))
(should (= point (point))))
;; Insert partly.
(let ((point (point)))
- (insert-file-contents tmp-name nil 1 3)
+ (should
+ (equal
+ (insert-file-contents tmp-name nil 1 3)
+ `(,(expand-file-name tmp-name) 2)))
(should (string-equal (buffer-string) "foofoooo"))
(should (= point (point))))
+ (let ((point (point)))
+ (should
+ (equal
+ (insert-file-contents tmp-name nil 2 5)
+ `(,(expand-file-name tmp-name) 1)))
+ (should (string-equal (buffer-string) "fooofoooo"))
+ (should (= point (point))))
;; Replace.
(let ((point (point)))
- (insert-file-contents tmp-name nil nil nil 'replace)
+ ;; 0 characters replaced, because "foo" is already there.
+ (should
+ (equal
+ (insert-file-contents tmp-name nil nil nil 'replace)
+ `(,(expand-file-name tmp-name) 0)))
(should (string-equal (buffer-string) "foo"))
(should (= point (point))))
+ ;; Insert another string.
+ ;; `replace-string-in-region' was introduced in Emacs 28.1.
+ (when (tramp--test-emacs28-p)
+ (let ((point (point)))
+ (with-no-warnings
+ (replace-string-in-region "foo" "bar" (point-min) (point-max)))
+ (goto-char point)
+ (should
+ (equal
+ (insert-file-contents tmp-name nil nil nil 'replace)
+ `(,(expand-file-name tmp-name) 3)))
+ (should (string-equal (buffer-string) "foo"))
+ (should (= point (point)))))
;; Error case.
(delete-file tmp-name)
(should-error
@@ -2634,17 +2673,14 @@ This checks also `file-name-as-directory', `file-name-directory',
(should (string-equal (buffer-string) "foo")))
;; Write empty string. Used for creation of temporary files.
- ;; Since Emacs 27.1.
- (when (fboundp 'make-empty-file)
- (with-no-warnings
- (should-error
- (make-empty-file tmp-name)
- :type 'file-already-exists)
- (delete-file tmp-name)
- (make-empty-file tmp-name)
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "")))))
+ (should-error
+ (make-empty-file tmp-name)
+ :type 'file-already-exists)
+ (delete-file tmp-name)
+ (make-empty-file tmp-name)
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "")))
;; Write partly.
(with-temp-buffer
@@ -2666,18 +2702,17 @@ This checks also `file-name-as-directory', `file-name-directory',
(string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
- (tramp-compat-rx
- bol "Wrote " (literal tmp-name) "\n" eos)
+ (rx bol "Wrote " (literal tmp-name) "\n" eos)
(rx bos))
tramp--test-messages))))))
- ;; We do not test lockname here. See
+ ;; We do not test the lock file here. See
;; `tramp-test39-make-lock-file-name'.
;; Do not overwrite if excluded.
- (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
+ (cl-letf (((symbol-function #'y-or-n-p) #'tramp-compat-always)
;; Ange-FTP.
- ((symbol-function #'yes-or-no-p) #'tramp--test-always))
+ ((symbol-function #'yes-or-no-p) #'tramp-compat-always))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
(should-error
(cl-letf (((symbol-function #'y-or-n-p) #'ignore)
@@ -2710,8 +2745,6 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check that `file-precious-flag' is respected with Tramp in use."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- ;; The bug is fixed in Emacs 27.1.
- (skip-unless (tramp--test-emacs27-p))
(let* ((tmp-name (tramp--test-make-temp-name))
(inhibit-message t)
@@ -2794,10 +2827,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `copy-file'."
(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-p) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(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 'local quoted)))
@@ -2906,10 +2936,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `rename-file'."
(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-p) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(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 'local quoted)))
@@ -3025,6 +3052,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))
+ ;; Since Emacs 29.1, `make-directory' has defined return values.
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo/bar" tmp-name1))
@@ -3033,7 +3061,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(unwind-protect
(progn
(with-file-modes unusual-file-mode-1
- (make-directory tmp-name1))
+ (if (tramp--test-emacs29-p)
+ (should-not (make-directory tmp-name1))
+ (make-directory tmp-name1)))
(should-error
(make-directory tmp-name1)
:type 'file-already-exists)
@@ -3046,15 +3076,19 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(make-directory tmp-name2)
:type 'file-error)
(with-file-modes unusual-file-mode-2
- (make-directory tmp-name2 'parents))
+ (if (tramp--test-emacs29-p)
+ (should-not (make-directory tmp-name2 'parents))
+ (make-directory tmp-name2 'parents)))
(should (file-directory-p tmp-name2))
(should (file-accessible-directory-p tmp-name2))
(when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-2)
(format "%#o" (file-modes tmp-name2)))))
;; If PARENTS is non-nil, `make-directory' shall not
- ;; signal an error when DIR exists already.
- (make-directory tmp-name2 'parents))
+ ;; signal an error when DIR exists already. It returns t.
+ (if (tramp--test-emacs29-p)
+ (should (make-directory tmp-name2 'parents))
+ (make-directory tmp-name2 'parents)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3086,13 +3120,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(delete-directory tmp-name1 'recursive)
(should-not (file-directory-p tmp-name1))
- ;; Trashing directories works only since Emacs 27.1. It doesn't
- ;; work when `system-move-file-to-trash' is defined (on MS
- ;; Windows and macOS), for encrypted remote directories and for
- ;; ange-ftp.
+ ;; Trashing directories doesn't work when
+ ;; `system-move-file-to-trash' is defined (on MS Windows and
+ ;; macOS), for encrypted remote directories and for ange-ftp.
(when (and (not (fboundp 'system-move-file-to-trash))
- (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))
- (tramp--test-emacs27-p))
+ (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p)))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@@ -3133,7 +3165,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)
(file-name-nondirectory tmp-name2))))
(delete-directory trash-directory 'recursive)
- (should-not (file-exists-p trash-directory)))))))
+ (should-not (file-exists-p trash-directory))))
+
+ ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash'
+ ;; prevents trashing remote files.
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t)
+ (remote-file-name-inhibit-delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (delete-directory tmp-name1 nil 'trash)
+ (should-not (file-exists-p tmp-name1))
+ (should-not
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory tmp-name1) trash-directory)))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory))))))
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
@@ -3361,9 +3409,6 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; (this is performed by `dired'). If FULL is nil, it shows just
;; one file. So we refrain from testing.
(skip-unless (not (tramp--test-ange-ftp-p)))
- ;; `insert-directory' of encrypted remote directories works only
- ;; since Emacs 27.1.
- (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -3381,26 +3426,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(with-temp-buffer
(insert-directory tmp-name1 nil)
(goto-char (point-min))
- (should (looking-at-p (tramp-compat-rx (literal tmp-name1)))))
+ (should (looking-at-p (rx (literal tmp-name1)))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) nil)
(goto-char (point-min))
(should
- (looking-at-p
- (tramp-compat-rx (literal (file-name-as-directory tmp-name1))))))
+ (looking-at-p (rx (literal (file-name-as-directory tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
- (looking-at-p
- (tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol))))
+ (looking-at-p (rx bol (+ nonl) blank (literal tmp-name1) eol))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) "-al")
(goto-char (point-min))
(should
(looking-at-p
- (tramp-compat-rx
- bol (+ nonl) blank (literal tmp-name1) "/" eol))))
+ (rx bol (+ nonl) blank (literal tmp-name1) "/" eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
@@ -3410,12 +3452,12 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(rx-to-string
`(:
;; There might be a summary line.
- (? "total" (+ nonl) (+ digit) (? blank)
+ (? (* blank) "total" (+ nonl) (+ digit) (? blank)
(? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order ".", ".." and "foo" appear.
(= ,(length (directory-files tmp-name1))
(+ nonl) blank
- (regexp ,(regexp-opt (directory-files tmp-name1)))
+ (| . ,(directory-files tmp-name1))
(? " ->" (+ nonl)) "\n"))))))
;; Check error cases.
@@ -3461,7 +3503,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(tmp-name4 (expand-file-name "bar" tmp-name2))
(ert-remote-temporary-file-directory
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
ert-remote-temporary-file-directory))
buffer)
(unwind-protect
@@ -3483,15 +3525,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"tramp-test*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name2 ert-remote-temporary-file-directory))))))
@@ -3505,15 +3547,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name4
@@ -3535,15 +3577,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
(literal
(file-relative-name
tmp-name4
@@ -3636,6 +3678,18 @@ This tests also `access-file', `file-readable-p',
attr)
(unwind-protect
(progn
+ (write-region "foo" nil tmp-name1)
+ ;; `access-file' returns nil in case of success.
+ (should-not (access-file tmp-name1 "error"))
+ ;; `access-file' could use a timeout.
+ (let ((remote-file-name-access-timeout 1))
+ (cl-letf (((symbol-function #'file-exists-p)
+ (lambda (_filename) (sleep-for 5))))
+ (should-error
+ (access-file tmp-name1 "error")
+ :type 'file-error)))
+ (delete-file tmp-name1)
+
;; A sticky bit could damage the `file-ownership-preserved-p' test.
(when
(and test-file-ownership-preserved-p
@@ -3716,7 +3770,7 @@ This tests also `access-file', `file-readable-p',
(should
(string-equal
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
@@ -3757,7 +3811,7 @@ This tests also `access-file', `file-readable-p',
(should (eq (file-attribute-type attr) t)))
;; Cleanup.
- (ignore-errors (delete-directory tmp-name1))
+ (ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
@@ -3780,9 +3834,6 @@ This tests also `access-file', `file-readable-p',
(cons '(nil "perl" nil)
tramp-connection-properties)))
(progn
- ;; `ert-test-result-duration' exists since Emacs 27. It
- ;; doesn't hurt to call it unconditionally, because
- ;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@@ -3811,9 +3862,6 @@ This tests also `access-file', `file-readable-p',
(nil "id" nil))
tramp-connection-properties)))
(progn
- ;; `ert-test-result-duration' exists since Emacs 27. It
- ;; doesn't hurt to call it unconditionally, because
- ;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@@ -3840,9 +3888,6 @@ This tests also `access-file', `file-readable-p',
(nil "readlink" nil))
tramp-connection-properties)))
(progn
- ;; `ert-test-result-duration' exists since Emacs 27. It
- ;; doesn't hurt to call it unconditionally, because
- ;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@@ -3878,9 +3923,9 @@ They might differ only in time attributes or directory size."
;; few seconds). We use a test start time minus 10 seconds, in
;; order to compensate a possible timestamp resolution higher than
;; a second on the remote machine.
- (when (or (tramp-compat-time-equal-p
+ (when (or (time-equal-p
(file-attribute-modification-time attr1) tramp-time-dont-know)
- (tramp-compat-time-equal-p
+ (time-equal-p
(file-attribute-modification-time attr2) tramp-time-dont-know))
(setcar (nthcdr 5 attr1) tramp-time-dont-know)
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
@@ -3891,9 +3936,9 @@ They might differ only in time attributes or directory size."
(float-time (file-attribute-modification-time attr2)))
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
;; Status change time. Ditto.
- (when (or (tramp-compat-time-equal-p
+ (when (or (time-equal-p
(file-attribute-status-change-time attr1) tramp-time-dont-know)
- (tramp-compat-time-equal-p
+ (time-equal-p
(file-attribute-status-change-time attr2) tramp-time-dont-know))
(setcar (nthcdr 6 attr1) tramp-time-dont-know)
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
@@ -4032,7 +4077,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(should
(string-equal
(funcall
- (if quoted #'tramp-compat-file-name-unquote #'identity)
+ (if quoted #'file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
;; Both report the modes of `tmp-name1'.
@@ -4105,7 +4150,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 #'file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(when (tramp--test-expensive-test-p)
@@ -4118,19 +4163,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists)))
- (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
(funcall
- (if quoted #'tramp-compat-file-name-unquote #'identity)
+ (if quoted #'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 #'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.
@@ -4140,7 +4185,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 #'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
@@ -4162,7 +4207,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 #'file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name5)))
;; Check, that files in symlinked directories still work.
@@ -4198,7 +4243,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
- (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
(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)
@@ -4256,16 +4301,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"/[penguin/motd]" "/penguin:motd:")))
(delete-file tmp-name2)
(make-symbolic-link
- (funcall
- (if quoted #'tramp-compat-file-name-unquote #'identity) penguin)
+ (funcall (if quoted #'file-name-unquote #'identity) penguin)
tmp-name2)
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name2))
(should
(string-equal
(file-truename tmp-name2)
- (tramp-compat-file-name-quote
- (concat (file-remote-p tmp-name2) penguin)))))
+ (file-name-quote (concat (file-remote-p tmp-name2) penguin)))))
;; `tmp-name3' is a local file name.
;; `make-symbolic-link' might not be permitted on w32 systems.
(unless (tramp--test-windows-nt-p)
@@ -4278,7 +4321,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should
(string-equal
(file-truename tmp-name1)
- (tramp-compat-file-name-unquote (file-truename tmp-name3))))))
+ (file-name-unquote (file-truename tmp-name3))))))
;; Cleanup.
(ignore-errors
@@ -4365,7 +4408,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 #'file-name-quote #'identity)
ert-remote-temporary-file-directory)))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
@@ -4394,12 +4437,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (set-file-times tmp-name1 (seconds-to-time 60)))
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
- (unless (tramp-compat-time-equal-p
+ (unless (time-equal-p
(file-attribute-modification-time
(file-attributes tmp-name1))
tramp-time-dont-know)
(should
- (tramp-compat-time-equal-p
+ (time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 60)))
;; Setting the time for not existing files shall fail.
@@ -4418,7 +4461,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-no-warnings
(set-file-times tmp-name1 (seconds-to-time 60) 'nofollow)
(should
- (tramp-compat-time-equal-p
+ (time-equal-p
(file-attribute-modification-time
(file-attributes tmp-name1))
(seconds-to-time 60)))))))
@@ -4464,10 +4507,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (file-acl ert-remote-temporary-file-directory))
(skip-unless (not (tramp--test-crypt-p)))
- ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
- (dolist (quoted
- (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(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 'local quoted)))
@@ -4544,10 +4584,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
'(nil nil nil nil))))
(skip-unless (not (tramp--test-crypt-p)))
- ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
- (dolist (quoted
- (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(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 'local quoted)))
@@ -4940,11 +4977,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(if (or (not (get-buffer "*Completions*"))
(string-match-p
(if (string-empty-p tramp-method-regexp)
- (tramp-compat-rx
+ (rx
(| (regexp tramp-postfix-user-regexp)
(regexp tramp-postfix-host-regexp))
eos)
- (tramp-compat-rx
+ (rx
(| (regexp tramp-postfix-method-regexp)
(regexp tramp-postfix-user-regexp)
(regexp tramp-postfix-host-regexp))
@@ -4967,10 +5004,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; We must remove leading `default-directory'.
(goto-char (point-min))
(let ((inhibit-read-only t))
- (while (re-search-forward "//" nil 'noerror)
+ (while (search-forward-regexp "//" nil 'noerror)
(delete-region (line-beginning-position) (point))))
(goto-char (point-min))
- (re-search-forward
+ (search-forward-regexp
(rx bol (0+ nonl)
(any "Pp") "ossible completions"
(0+ nonl) eol))
@@ -5082,7 +5119,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp
+ ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (if destination (format "%s\n" fnnd) "")
@@ -5096,7 +5134,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp
+ ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
@@ -5241,9 +5280,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unless t
(unwind-protect
(with-temp-buffer
- (setq command '("cat")
- proc
- (apply #'start-file-process "test4" (current-buffer) command))
+ (setq command '("cat")
+ proc
+ (apply
+ #'start-file-process "test4" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5263,12 +5303,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Process connection type.
(when (and (tramp--test-sh-p)
(not (tramp-direct-async-process-p))
- ;; `executable-find' has changed the number of
- ;; parameters in Emacs 27.1, so we use `apply' for
- ;; older Emacsen.
- (ignore-errors
- (with-no-warnings
- (apply #'executable-find '("hexdump" remote)))))
+ (executable-find "hexdump" 'remote))
(dolist (process-connection-type '(nil pipe t pty))
(unwind-protect
(with-temp-buffer
@@ -5323,33 +5358,29 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Define ert test `TEST-direct-async' for direct async processes.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
- ;; `make-process' supports file name handlers since Emacs 27. We
- ;; cannot use `tramp--test-always' during compilation of the macro.
- (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
- (ignore-errors (make-process :name "" :command "" :file-handler t)))
- `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
- ;; This is the docstring. However, it must be expanded to a
- ;; string inside the macro. No idea.
- ;; (concat (ert-test-documentation (get ',test 'ert--test))
- ;; "\nUse direct async process.")
- :tags (append '(:expensive-test :tramp-asynchronous-processes)
- (and ,unstable '(:unstable)))
- (skip-unless (tramp--test-enabled))
- (let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (cons '(nil "direct-async-process" t)
- tramp-connection-properties)))
- (skip-unless (tramp-direct-async-process-p))
- ;; We do expect an established connection already,
- ;; `file-truename' does it by side-effect. Suppress
- ;; `tramp--test-enabled', in order to keep the connection.
- ;; Suppress "Process ... finished" messages.
- (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always)
- ((symbol-function #'internal-default-process-sentinel)
- #'ignore))
- (file-truename ert-remote-temporary-file-directory)
- (funcall (ert-test-body ert-test)))))))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
+ ;; This is the docstring. However, it must be expanded to a
+ ;; string inside the macro. No idea.
+ ;; (concat (ert-test-documentation (get ',test 'ert--test))
+ ;; "\nUse direct async process.")
+ :tags (append '(:expensive-test :tramp-asynchronous-processes)
+ (and ,unstable '(:unstable)))
+ (skip-unless (tramp--test-enabled))
+ (let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (tramp-connection-properties
+ (cons '(nil "direct-async-process" t)
+ tramp-connection-properties)))
+ (skip-unless (tramp-direct-async-process-p))
+ ;; We do expect an established connection already,
+ ;; `file-truename' does it by side-effect. Suppress
+ ;; `tramp--test-enabled', in order to keep the connection.
+ ;; Suppress "Process ... finished" messages.
+ (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always)
+ ((symbol-function #'internal-default-process-sentinel)
+ #'ignore))
+ (file-truename ert-remote-temporary-file-directory)
+ (funcall (ert-test-body ert-test))))))
(tramp--test-deftest-direct-async-process tramp-test29-start-file-process)
@@ -5360,8 +5391,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
- ;; `make-process' supports file name handlers since Emacs 27.
- (skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory ert-remote-temporary-file-directory)
@@ -5374,10 +5403,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat")
proc
- (with-no-warnings
- (make-process
- :name "test1" :buffer (current-buffer) :command command
- :file-handler t)))
+ (make-process
+ :name "test1" :buffer (current-buffer) :command command
+ :file-handler t))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5399,10 +5427,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(should (file-exists-p tmp-name))
(setq command `("cat" ,(file-name-nondirectory tmp-name))
proc
- (with-no-warnings
- (make-process
- :name "test2" :buffer (current-buffer) :command command
- :file-handler t)))
+ (make-process
+ :name "test2" :buffer (current-buffer) :command command
+ :file-handler t))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
;; Read output.
@@ -5421,13 +5448,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat")
proc
- (with-no-warnings
- (make-process
- :name "test3" :buffer (current-buffer) :command command
- :filter
- (lambda (p s)
- (with-current-buffer (process-buffer p) (insert s)))
- :file-handler t)))
+ (make-process
+ :name "test3" :buffer (current-buffer) :command command
+ :filter
+ (lambda (p s)
+ (with-current-buffer (process-buffer p) (insert s)))
+ :file-handler t))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5448,11 +5474,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat")
proc
- (with-no-warnings
- (make-process
- :name "test4" :buffer (current-buffer) :command command
- :filter t
- :file-handler t)))
+ (make-process
+ :name "test4" :buffer (current-buffer) :command command
+ :filter t :file-handler t))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5473,13 +5497,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat")
proc
- (with-no-warnings
- (make-process
- :name "test5" :buffer (current-buffer) :command command
- :sentinel
- (lambda (p s)
- (with-current-buffer (process-buffer p) (insert s)))
- :file-handler t)))
+ (make-process
+ :name "test5" :buffer (current-buffer) :command command
+ :sentinel
+ (lambda (p s)
+ (with-current-buffer (process-buffer p) (insert s)))
+ :file-handler t))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5505,11 +5528,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat" "/does-not-exist")
proc
- (with-no-warnings
- (make-process
- :name "test6" :buffer (current-buffer) :command command
- :stderr stderr
- :file-handler t)))
+ (make-process
+ :name "test6" :buffer (current-buffer) :command command
+ :stderr stderr :file-handler t))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
;; Read output.
@@ -5538,11 +5559,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("cat" "/does-not-exist")
proc
- (with-no-warnings
- (make-process
- :name "test7" :buffer (current-buffer) :command command
- :stderr tmp-name
- :file-handler t)))
+ (make-process
+ :name "test7" :buffer (current-buffer) :command command
+ :stderr tmp-name :file-handler t))
(should (processp proc))
(should (equal (process-get proc 'remote-command) command))
;; Read stderr.
@@ -5563,12 +5582,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Process connection type.
(when (and (tramp--test-sh-p)
(not (tramp-direct-async-process-p))
- ;; `executable-find' has changed the number of
- ;; parameters in Emacs 27.1, so we use `apply' for
- ;; older Emacsen.
- (ignore-errors
- (with-no-warnings
- (apply #'executable-find '("hexdump" remote)))))
+ (executable-find "hexdump" 'remote))
(dolist (connection-type '(nil pipe t pty))
;; `process-connection-type' is taken when
;; `:connection-type' is nil.
@@ -5578,15 +5592,14 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
proc
- (with-no-warnings
- (make-process
- :name
- (format "test8-%s-%s"
- connection-type process-connection-type)
- :buffer (current-buffer)
- :connection-type connection-type
- :command command
- :file-handler t)))
+ (make-process
+ :name
+ (format "test8-%s-%s"
+ connection-type process-connection-type)
+ :buffer (current-buffer)
+ :connection-type connection-type
+ :command command
+ :file-handler t))
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
@@ -5620,8 +5633,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-windows-nt-p)))
(skip-unless (not (tramp--test-crypt-p)))
- ;; Since Emacs 27.1.
- (skip-unless (macrop 'with-connection-local-variables))
;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
@@ -5663,8 +5674,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-windows-nt-p)))
(skip-unless (not (tramp--test-crypt-p)))
- ;; Since Emacs 27.1.
- (skip-unless (macrop 'with-connection-local-variables))
;; Since Emacs 29.1.
(skip-unless (boundp 'signal-process-functions))
@@ -5675,55 +5684,69 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(delete-exited-processes t)
kill-buffer-query-functions command proc)
- (dolist (sigcode '(2 INT))
- (unwind-protect
- (with-temp-buffer
- (setq command "trap 'echo boom; exit 1' 2; sleep 100"
- proc (start-file-process-shell-command
- (format "test1%s" sigcode) (current-buffer) command))
- (should (processp proc))
- (should (process-live-p proc))
- (should (equal (process-status proc) 'run))
- (should (numberp (process-get proc 'remote-pid)))
- (should (equal (process-get proc 'remote-command)
- (with-connection-local-variables
- `(,shell-file-name ,shell-command-switch ,command))))
- (should (zerop (signal-process proc sigcode)))
- ;; Let the process accept the signal.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (should-not (process-live-p proc)))
+ ;; If PROCESS is a string, it must be a process name or a process
+ ;; number. Check error handling.
+ (should-error
+ (signal-process (md5 (current-time-string)) 0)
+ :type 'wrong-type-argument)
+
+ ;; The PROCESS argument of `signal-process' can be a string. Test
+ ;; this as well.
+ (dolist
+ (func '(identity
+ (lambda (x) (format "%s" (if (processp x) (process-name x) x)))))
+ (dolist (sigcode '(2 INT))
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test1-%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
+ (should
+ (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
+ (should (zerop (signal-process (funcall func proc) sigcode)))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
- ;; Cleanup.
- (ignore-errors (kill-process proc))
- (ignore-errors (delete-process proc)))
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc)))
- (unwind-protect
- (with-temp-buffer
- (setq command "trap 'echo boom; exit 1' 2; sleep 100"
- proc (start-file-process-shell-command
- (format "test2%s" sigcode) (current-buffer) command))
- (should (processp proc))
- (should (process-live-p proc))
- (should (equal (process-status proc) 'run))
- (should (numberp (process-get proc 'remote-pid)))
- (should (equal (process-get proc 'remote-command)
- (with-connection-local-variables
- `(,shell-file-name ,shell-command-switch ,command))))
- ;; `signal-process' has argument REMOTE since Emacs 29.
- (with-no-warnings
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test2-%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
(should
- (zerop
- (signal-process
- (process-get proc 'remote-pid) sigcode default-directory))))
- ;; Let the process accept the signal.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (should-not (process-live-p proc)))
+ (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
+ ;; `signal-process' has argument REMOTE since Emacs 29.
+ (with-no-warnings
+ (should
+ (zerop
+ (signal-process
+ (funcall func (process-get proc 'remote-pid))
+ sigcode default-directory))))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
- ;; Cleanup.
- (ignore-errors (kill-process proc))
- (ignore-errors (delete-process proc))))))
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc)))))))
(ert-deftest tramp-test31-list-system-processes ()
"Check `list-system-processes'."
@@ -5765,7 +5788,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; (tramp--test-message "%s" attributes)
(should (equal (cdr (assq 'comm attributes)) (car command)))
(should (equal (cdr (assq 'args attributes))
- (mapconcat #'identity command " ")))))
+ (string-join command " ")))))
;; Cleanup.
(ignore-errors (delete-process proc)))))
@@ -5791,11 +5814,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
INPUT, if non-nil, is a string sent to the process."
(let ((proc (async-shell-command command output-buffer error-buffer))
(delete-exited-processes t))
- ;; Since Emacs 27.1.
- (when (macrop 'with-connection-local-variables)
- (should (equal (process-get proc 'remote-command)
- (with-connection-local-variables
- `(,shell-file-name ,shell-command-switch ,command)))))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
(cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
(when (stringp input)
(process-send-string proc input))
@@ -5816,10 +5837,6 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-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.
- (when (tramp--test-adb-p)
- (skip-unless (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
@@ -5847,7 +5864,7 @@ INPUT, if non-nil, is a string sent to the process."
(current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
- (while (re-search-forward ansi-color-control-seq-regexp nil t)
+ (while (search-forward-regexp ansi-color-control-seq-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
@@ -5886,7 +5903,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-match-p
;; Some shells echo, for example the "adb" or container methods.
- (tramp-compat-rx
+ (rx
bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
eos)
(buffer-string))))
@@ -5894,10 +5911,8 @@ INPUT, if non-nil, is a string sent to the process."
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
- ;; Test `async-shell-command-width'. It exists since Emacs 26.1,
- ;; but seems to work since Emacs 27.1 only.
- (when (and (tramp--test-asynchronous-processes-p)
- (tramp--test-sh-p) (tramp--test-emacs27-p))
+ ;; Test `async-shell-command-width'.
+ (when (and (tramp--test-asynchronous-processes-p) (tramp--test-sh-p))
(let* ((async-shell-command-width 1024)
(default-directory ert-remote-temporary-file-directory)
(cols (ignore-errors
@@ -5917,8 +5932,6 @@ INPUT, if non-nil, is a string sent to the process."
(skip-unless (tramp--test-enabled))
(skip-unless nil)
(skip-unless (tramp--test-supports-processes-p))
- ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
- (skip-unless (tramp--test-emacs27-p))
;; (message " s-c-d-e-b current-buffer buffer-string point")
;; (message "===============================================")
@@ -6093,8 +6106,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is set.
(should
(string-match-p
- (tramp-compat-rx (literal envvar))
- (funcall this-shell-command-to-string "set"))))
+ (rx (literal envvar)) (funcall this-shell-command-to-string "set"))))
(unless (tramp-direct-async-process-p)
;; We force a reconnect, in order to have a clean environment.
@@ -6122,7 +6134,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is unset.
(should-not
(string-match-p
- (tramp-compat-rx (literal envvar))
+ (rx (literal envvar))
;; We must remove PS1, the output is truncated otherwise.
;; We must suppress "_=VAR...".
(funcall
@@ -6167,13 +6179,10 @@ INPUT, if non-nil, is a string sent to the process."
(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 (macrop 'with-connection-local-variables))
(let* ((default-directory ert-remote-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name))
@@ -6183,8 +6192,7 @@ INPUT, if non-nil, is a string sent to the process."
(inhibit-message t)
kill-buffer-query-functions
(clpa connection-local-profile-alist)
- (clca connection-local-criteria-alist)
- connection-local-profile-alist connection-local-criteria-alist)
+ (clca connection-local-criteria-alist))
(unwind-protect
(progn
(make-directory tmp-name1)
@@ -6214,22 +6222,42 @@ INPUT, if non-nil, is a string sent to the process."
(should (eq local-variable 'connect))
(kill-buffer (current-buffer)))
- ;; `local-variable' is dir-local due to existence of .dir-locals.el.
+ ;; `local-variable' is still connection-local due to Tramp.
+ ;; `find-file-hook' overrides dir-local settings.
(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.
+ (when (memq #'tramp-set-connection-local-variables-for-buffer
+ find-file-hook)
+ (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.
+ (let ((find-file-hook
+ (remq #'tramp-set-connection-local-variables-for-buffer
+ find-file-hook)))
+ (with-current-buffer (find-file-noselect tmp-name2)
+ (should (eq local-variable 'dir))
+ (kill-buffer (current-buffer))))
+
+ ;; `local-variable' is still connection-local due to Tramp.
+ ;; `find-file-hook' overrides dir-local settings.
(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))))
+ (when (memq #'tramp-set-connection-local-variables-for-buffer
+ find-file-hook)
+ (with-current-buffer (find-file-noselect tmp-name2)
+ (should (eq local-variable 'connect))
+ (kill-buffer (current-buffer))))
+ ;; `local-variable' is file-local due to specifying as file variable.
+ (let ((find-file-hook
+ (remq #'tramp-set-connection-local-variables-for-buffer
+ find-file-hook)))
+ (with-current-buffer (find-file-noselect tmp-name2)
+ (should (eq local-variable 'file))
+ (kill-buffer (current-buffer)))))
;; Cleanup.
(custom-set-variables
@@ -6242,21 +6270,13 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-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.
- (when (tramp--test-adb-p)
- (skip-unless (tramp--test-emacs27-p)))
(let ((default-directory ert-remote-temporary-file-directory)
explicit-shell-file-name kill-buffer-query-functions
(clpa connection-local-profile-alist)
- (clca connection-local-criteria-alist)
- connection-local-profile-alist connection-local-criteria-alist)
+ (clca connection-local-criteria-alist))
(unwind-protect
(progn
- ;; `shell-mode' would ruin our test, because it deletes all
- ;; buffer local variables. Not needed in Emacs 27.1.
- (put 'explicit-shell-file-name 'permanent-local t)
(connection-local-set-profile-variables
'remote-sh
`((explicit-shell-file-name . ,(tramp--test-shell-file-name))
@@ -6290,29 +6310,24 @@ INPUT, if non-nil, is a string sent to the process."
`(connection-local-criteria-alist ',clca now))
(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-test35-exec-path ()
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(skip-unless (tramp--test-supports-set-file-modes-p))
- ;; Since Emacs 27.1.
- (skip-unless (fboundp 'exec-path))
(let ((tmp-name (tramp--test-make-temp-name))
(default-directory ert-remote-temporary-file-directory))
(unwind-protect
(progn
- (should (consp (with-no-warnings (exec-path))))
+ (should (consp (exec-path)))
;; Last element is the `exec-directory'.
(should
(string-equal
- (car (last (with-no-warnings (exec-path))))
+ (car (last (exec-path)))
(file-remote-p default-directory 'localname)))
;; The shell "sh" shall always exist.
- (should (apply #'executable-find '("sh" remote)))
+ (should (executable-find "sh" 'remote))
;; Since the last element in `exec-path' is the current
;; directory, an executable file in that directory will be
;; found.
@@ -6323,56 +6338,51 @@ INPUT, if non-nil, is a string sent to the process."
(should (file-executable-p tmp-name))
(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
- `(,(concat (file-name-nondirectory tmp-name) "foo") remote))))
+ (executable-find
+ (concat (file-name-nondirectory tmp-name) "foo") 'remote)))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
+(tramp--test-deftest-direct-async-process tramp-test35-exec-path)
+
;; 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))
(skip-unless (not (tramp--test-crypt-p)))
- ;; Since Emacs 27.1.
- (skip-unless (fboundp 'exec-path))
(let* ((tmp-name (tramp--test-make-temp-name))
(default-directory ert-remote-temporary-file-directory)
- (orig-exec-path (with-no-warnings (exec-path)))
+ (orig-exec-path (exec-path))
(tramp-remote-path tramp-remote-path)
(orig-tramp-remote-path tramp-remote-path)
path)
+ ;; The "flatpak" method modifies `tramp-remote-path'.
+ (skip-unless (not (tramp-compat-connection-local-p 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-test-vec 'keep-debug 'keep-password)
- (should (equal (with-no-warnings (exec-path)) orig-exec-path))
+ (should (equal (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-test-vec 'keep-debug 'keep-password)
- (should
- (equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path)))
+ (should (equal (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 (tramp-compat-length<
- (mapconcat #'identity orig-exec-path ":") 5000)
+ (while (tramp-compat-length< (string-join 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
@@ -6384,7 +6394,7 @@ INPUT, if non-nil, is a string sent to the process."
`(,(file-remote-p dir 'localname))
(last orig-exec-path)))))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (should (equal (with-no-warnings (exec-path)) orig-exec-path))
+ (should (equal (exec-path) orig-exec-path))
;; Ignore trailing newline.
(setq path (substring (shell-command-to-string "echo $PATH") nil -1))
;; The shell doesn't handle such long strings.
@@ -6394,16 +6404,17 @@ INPUT, if non-nil, is a string sent to the process."
tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
(should
- (string-equal
- path (mapconcat #'identity (butlast orig-exec-path) ":"))))
+ (string-equal path (string-join (butlast orig-exec-path) ":"))))
;; The shell "sh" shall always exist.
- (should (apply #'executable-find '("sh" remote))))
+ (should (executable-find "sh" 'remote)))
;; Cleanup.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(setq tramp-remote-path orig-tramp-remote-path)
(ignore-errors (delete-directory tmp-name 'recursive)))))
+(tramp--test-deftest-direct-async-process tramp-test35-remote-path)
+
(ert-deftest tramp-test36-vc-registered ()
"Check `vc-registered'."
:tags '(:expensive-test)
@@ -6517,7 +6528,7 @@ INPUT, if non-nil, is a string sent to the process."
(string-equal
(make-auto-save-file-name)
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(expand-file-name
(format "#%s#" (file-name-nondirectory tmp-name1))
ert-remote-temporary-file-directory))))))
@@ -6542,7 +6553,7 @@ INPUT, if non-nil, is a string sent to the process."
("|" . "__")
("[" . "_l")
("]" . "_r"))
- (tramp-compat-file-name-unquote tmp-name1)))
+ (file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2)))))
@@ -6566,7 +6577,7 @@ INPUT, if non-nil, is a string sent to the process."
("|" . "__")
("[" . "_l")
("]" . "_r"))
- (tramp-compat-file-name-unquote tmp-name1)))
+ (file-name-unquote tmp-name1)))
tmp-name2)))
(should (file-directory-p tmp-name2)))))
@@ -6592,7 +6603,7 @@ INPUT, if non-nil, is a string sent to the process."
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'yes-or-no-p)
- #'tramp--test-always))
+ #'tramp-compat-always))
(should (stringp (make-auto-save-file-name))))))))
;; Cleanup.
@@ -6622,7 +6633,7 @@ INPUT, if non-nil, is a string sent to the process."
(find-backup-file-name tmp-name1)
(list
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(expand-file-name
(format "%s~" (file-name-nondirectory tmp-name1))
ert-remote-temporary-file-directory))))))
@@ -6639,7 +6650,7 @@ INPUT, if non-nil, is a string sent to the process."
(find-backup-file-name tmp-name1)
(list
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(expand-file-name
(format
"%s~"
@@ -6668,7 +6679,7 @@ INPUT, if non-nil, is a string sent to the process."
(find-backup-file-name tmp-name1)
(list
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(expand-file-name
(format
"%s~"
@@ -6699,7 +6710,7 @@ INPUT, if non-nil, is a string sent to the process."
(find-backup-file-name tmp-name1)
(list
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(expand-file-name
(format
"%s~"
@@ -6738,8 +6749,7 @@ INPUT, if non-nil, is a string sent to the process."
:type 'file-error))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'yes-or-no-p)
- #'tramp--test-always))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
(should (stringp (car (find-backup-file-name tmp-name1)))))))
;; Cleanup.
@@ -6756,7 +6766,7 @@ INPUT, if non-nil, is a string sent to the process."
(skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
;; `lock-file', `unlock-file', `file-locked-p' and
- ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
+ ;; `make-lock-file-name' exist since Emacs 28.1. We don't want to
;; see compiler warnings for older Emacsen.
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -6790,11 +6800,33 @@ INPUT, if non-nil, is a string sent to the process."
(save-buffer)
(should-not (buffer-modified-p)))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
+
+ ;; `kill-buffer' removes the lock.
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (cl-letf (((symbol-function #'read-from-minibuffer)
+ (lambda (&rest _args) "yes")))
+ (kill-buffer)))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ ;; `kill-buffer' should not remove the lock when the
+ ;; connection is broken. See Bug#61663.
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-from-minibuffer)
+ (lambda (&rest _args) "yes")))
+ (kill-buffer)))
;; A new connection changes process id, and also the
- ;; lockname contents.
+ ;; lock file contents. But it still exists.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
@@ -6872,8 +6904,7 @@ INPUT, if non-nil, is a string sent to the process."
:type 'file-error))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'yes-or-no-p)
- #'tramp--test-always))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
(write-region "foo" nil tmp-name1))))
;; Cleanup.
@@ -6944,7 +6975,8 @@ INPUT, if non-nil, is a string sent to the process."
(should (file-locked-p tmp-name)))))
;; `save-buffer' removes the file lock.
- (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ #'tramp-compat-always)
((symbol-function #'read-char-choice)
(lambda (&rest _) ?y)))
(should (buffer-modified-p))
@@ -6958,7 +6990,6 @@ INPUT, if non-nil, is a string sent to the process."
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)))))))
-;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
@@ -6990,12 +7021,6 @@ INPUT, if non-nil, is a string sent to the process."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(defun tramp--test-emacs27-p ()
- "Check for Emacs version >= 27.1.
-Some semantics has been changed for there, without new functions
-or variables, so we check the Emacs version directly."
- (>= emacs-major-version 27))
-
(defun tramp--test-emacs28-p ()
"Check for Emacs version >= 28.1.
Some semantics has been changed for there, without new functions
@@ -7028,9 +7053,9 @@ This is used in tests which we don't want to tag
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:tramp-asynchronous-processes))))
- ;; tramp-adb.el cannot apply multi-byte commands.
+ ;; tramp-adb.el cannot apply multibyte commands.
(not (and (tramp--test-adb-p)
- (string-match-p (tramp-compat-rx multibyte) default-directory)))))
+ (string-match-p (rx multibyte) default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is encrypted."
@@ -7104,10 +7129,29 @@ This does not support external Emacs calls."
(string-equal
"mock" (file-remote-p ert-remote-temporary-file-directory 'method)))
+(defun tramp--test-netbsd-p ()
+ "Check, whether the remote host runs NetBSD."
+ ;; We must refill the cache. `file-truename' does it.
+ (file-truename ert-remote-temporary-file-directory)
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec "NetBSD")))
+
+(defun tramp--test-openbsd-p ()
+ "Check, whether the remote host runs OpenBSD."
+ ;; We must refill the cache. `file-truename' does it.
+ (file-truename ert-remote-temporary-file-directory)
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec "OpenBSD")))
+
(defun tramp--test-out-of-band-p ()
"Check, whether an out-of-band method is used."
(tramp-method-out-of-band-p tramp-test-vec 1))
+(defun tramp--test-putty-p ()
+ "Check, whether the method method usaes PuTTY.
+This does not support connection share for more than two connections."
+ (member
+ (file-remote-p ert-remote-temporary-file-directory 'method)
+ '("plink" "plinkx" "pscp" "psftp")))
+
(defun tramp--test-rclone-p ()
"Check, whether the remote host is offered by rclone.
This requires restrictions of file name syntax."
@@ -7195,10 +7239,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-p) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(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.
@@ -7248,7 +7289,7 @@ This requires restrictions of file name syntax."
(should
(string-equal
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
@@ -7331,22 +7372,24 @@ This requires restrictions of file name syntax."
;; Check symlink in `directory-files-and-attributes'.
;; It does not work in the "smb" case, only relative
- ;; symlinks to existing files are shown there.
+ ;; symlinks to existing files are shown there. On
+ ;; NetBSD, there are problems with loooong file names,
+ ;; see Bug#65324.
(tramp--test-ignore-make-symbolic-link-error
- (unless (tramp--test-smb-p)
+ (unless (or (tramp--test-netbsd-p) (tramp--test-smb-p))
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
(string-equal
(caar (directory-files-and-attributes
- file1 nil (tramp-compat-rx (literal elt1))))
+ file1 nil (rx (literal elt1))))
elt1))
(should
(string-equal
(funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
+ (if quoted #'file-name-quote #'identity)
(cadr (car (directory-files-and-attributes
- file1 nil (tramp-compat-rx (literal elt1))))))
+ file1 nil (rx (literal elt1))))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3))))
@@ -7355,15 +7398,7 @@ This requires restrictions of file name syntax."
;; `default-directory' with special characters. See
;; Bug#53846.
(when (and (tramp--test-expensive-test-p)
- (tramp--test-supports-processes-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. tramp-sshfs.el times
- ;; out for older Emacsen, reason unknown.
- (or (and (not (tramp--test-adb-p))
- (not (tramp--test-sshfs-p)))
- (tramp--test-emacs27-p)))
+ (tramp--test-supports-processes-p))
(let ((default-directory file1))
(dolist (this-shell-command
(append
@@ -7400,8 +7435,8 @@ This requires restrictions of file name syntax."
(when (zerop (process-file "printenv" nil t nil))
(goto-char (point-min))
(should
- (re-search-forward
- (tramp-compat-rx
+ (search-forward-regexp
+ (rx
bol (literal envvar)
"=" (literal (getenv envvar)) eol)))))))))
@@ -7429,6 +7464,7 @@ This requires restrictions of file name syntax."
(cond ((or (tramp--test-ange-ftp-p)
(tramp--test-container-p)
(tramp--test-gvfs-p)
+ (tramp--test-openbsd-p)
(tramp--test-rclone-p)
(tramp--test-sudoedit-p)
(tramp--test-windows-nt-or-smb-p))
@@ -7473,7 +7509,7 @@ This requires restrictions of file name syntax."
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
(if (tramp--test-expensive-test-p)
- files (list (mapconcat #'identity files ""))))))
+ files (list (string-join files ""))))))
(tramp--test-deftest-with-stat tramp-test41-special-characters)
@@ -7509,7 +7545,8 @@ This requires restrictions of file name syntax."
"Автостопом по гала́ктике"
;; Use codepoints without a name. See Bug#31272.
;; Works on some Android systems only.
- (unless (tramp--test-adb-p) "™›šbung")
+ (unless (or (tramp--test-adb-p) (tramp--test-openbsd-p))
+ "™›šbung")
;; Use codepoints from Supplementary Multilingual Plane (U+10000
;; to U+1FFFF).
"🌈🍒👋")
@@ -7549,23 +7586,51 @@ This requires restrictions of file name syntax."
(ert-deftest tramp-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
- ;; Since Emacs 27.1.
- (skip-unless (fboundp 'file-system-info))
- ;; `file-system-info' exists since Emacs 27.1. We don't want to see
- ;; compiler warnings for older Emacsen.
- (when-let ((fsi (with-no-warnings
- (file-system-info ert-remote-temporary-file-directory))))
+ (when-let ((fsi (file-system-info ert-remote-temporary-file-directory)))
(should (consp fsi))
(should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
(should (natnump (or (nth i fsi) 0))))))
-;; `tramp-test44-asynchronous-requests' could be blocked. So we set a
+;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1.
+(ert-deftest tramp-test44-file-user-group-ids ()
+ "Check results of user/group functions.
+`file-user-uid', `file-group-gid', and `tramp-get-remote-*'
+should all return proper values."
+ (skip-unless (tramp--test-enabled))
+
+ (let ((default-directory ert-remote-temporary-file-directory))
+ ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1.
+ ;; We don't want to see compiler warnings for older Emacsen.
+ (when (fboundp 'file-user-uid)
+ (should (integerp (with-no-warnings (file-user-uid)))))
+ (when (fboundp 'file-group-gid)
+ (should (integerp (with-no-warnings (file-group-gid)))))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (should (or (integerp (tramp-get-remote-uid v 'integer))
+ (null (tramp-get-remote-uid v 'integer))))
+ (should (or (stringp (tramp-get-remote-uid v 'string))
+ (null (tramp-get-remote-uid v 'string))))
+
+ (should (or (integerp (tramp-get-remote-gid v 'integer))
+ (null (tramp-get-remote-gid v 'integer))))
+ (should (or (stringp (tramp-get-remote-gid v 'string))
+ (null (tramp-get-remote-gid v 'string))))
+
+ (when-let ((groups (tramp-get-remote-groups v 'integer)))
+ (should (consp groups))
+ (dolist (group groups) (should (integerp group))))
+ (when-let ((groups (tramp-get-remote-groups v 'string)))
+ (should (consp groups))
+ (dolist (group groups) (should (stringp group)))))))
+
+;; `tramp-test45-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-test44-asynchronous-requests'.")
+ "Timeout for `tramp-test45-asynchronous-requests'.")
(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
"Set \"process-name\" and \"process-buffer\" connection properties.
@@ -7601,17 +7666,13 @@ This is needed in timer functions as well as process filters and sentinels."
(tramp-flush-connection-property v "process-buffer")))))
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test44-asynchronous-requests ()
+(ert-deftest tramp-test45-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 :tramp-asynchronous-processes :unstable)
+ :tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-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.
- (when (tramp--test-adb-p)
- (skip-unless (tramp--test-emacs27-p)))
(skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-telnet-p)))
(skip-unless (not (tramp--test-sshfs-p)))
@@ -7647,6 +7708,10 @@ process sentinels. They shall not disturb each other."
(string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))))
((getenv "EMACS_HYDRA_CI") 5)
(t 10)))
+ ;; PuTTY-based methods can only share up to 10 connections.
+ (tramp-use-connection-share
+ (if (and (tramp--test-putty-p) (>= number-proc 10))
+ 'suppress (bound-and-true-p tramp-use-connection-share)))
;; On hydra, timings are bad.
(timer-repeat
(cond
@@ -7677,14 +7742,12 @@ process sentinels. They shall not disturb each other."
(when buffers
(let ((time (float-time))
(default-directory tmp-name)
- (file (buffer-name (seq-random-elt buffers)))
- ;; A remote operation in a timer could
- ;; confuse Tramp heavily. So we ignore this
- ;; error here.
- (debug-ignored-errors
- (cons 'remote-file-error debug-ignored-errors)))
+ (file (buffer-name (seq-random-elt buffers))))
(tramp--test-message
"Start timer %s %s" file (current-time-string))
+ (dired-uncache file)
+ (tramp--test-message
+ "Continue timer %s %s" file (file-attributes file))
(vc-registered file)
(tramp--test-message
"Stop timer %s %s" file (current-time-string))
@@ -7772,7 +7835,7 @@ process sentinels. They shall not disturb each other."
(setq buffers (delq buf buffers))))
(setq buffers (delq buf buffers)))))
- ;; Checks. All process output shall exists in the
+ ;; Checks. All process output shall exist in the
;; respective buffers. All created files shall be
;; deleted.
(tramp--test-message "Check %s" (current-time-string))
@@ -7798,10 +7861,10 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
-;; (tramp--test-deftest-direct-async-process tramp-test44-asynchronous-requests
+;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests
;; 'unstable)
-(ert-deftest tramp-test45-dired-compress-file ()
+(ert-deftest tramp-test46-dired-compress-file ()
"Check that Tramp (un)compresses normal files."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -7822,7 +7885,7 @@ process sentinels. They shall not disturb each other."
(should (string= tmp-name (dired-get-filename)))
(delete-file tmp-name)))
-(ert-deftest tramp-test45-dired-compress-dir ()
+(ert-deftest tramp-test46-dired-compress-dir ()
"Check that Tramp (un)compresses directories."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -7844,7 +7907,7 @@ process sentinels. They shall not disturb each other."
(delete-directory tmp-name)
(delete-file (concat tmp-name ".tar.gz"))))
-(ert-deftest tramp-test46-read-password ()
+(ert-deftest tramp-test47-read-password ()
"Check Tramp password handling."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -7903,7 +7966,7 @@ process sentinels. They shall not disturb each other."
(let ((auth-sources `(,netrc-file)))
(should (file-exists-p ert-remote-temporary-file-directory)))))))))
-(ert-deftest tramp-test46-read-otp-password ()
+(ert-deftest tramp-test47-read-otp-password ()
"Check Tramp one-time password handling."
:tags '(:expensive-test)
(skip-unless (tramp--test-mock-p))
@@ -7963,7 +8026,7 @@ process sentinels. They shall not disturb each other."
(file-exists-p ert-remote-temporary-file-directory)))))))))
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test47-auto-load ()
+(ert-deftest tramp-test48-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -7988,7 +8051,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test47-delay-load ()
+(ert-deftest tramp-test48-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file
@@ -8006,7 +8069,7 @@ process sentinels. They shall not disturb each other."
(dolist (tm '(t nil))
(should
(string-match-p
- (tramp-compat-rx
+ (rx
"Tramp loaded: nil" (+ (any "\r\n"))
"Tramp loaded: nil" (+ (any "\r\n"))
"Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n")))
@@ -8018,7 +8081,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-test47-recursive-load ()
+(ert-deftest tramp-test48-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -8042,7 +8105,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test47-remote-load-path ()
+(ert-deftest tramp-test48-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
@@ -8054,7 +8117,7 @@ process sentinels. They shall not disturb each other."
(tramp-cleanup-all-connections))"))
(should
(string-match-p
- (tramp-compat-rx
+ (rx
"Loading "
(literal
(expand-file-name
@@ -8067,7 +8130,22 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test48-unload ()
+(ert-deftest tramp-test49-without-remote-files ()
+ "Check that Tramp can be suppressed."
+ (skip-unless (tramp--test-enabled))
+
+ (should (file-remote-p ert-remote-temporary-file-directory))
+ (should-not
+ (without-remote-files (file-remote-p ert-remote-temporary-file-directory)))
+ (should (file-remote-p ert-remote-temporary-file-directory))
+
+ (inhibit-remote-files)
+ (should-not (file-remote-p ert-remote-temporary-file-directory))
+ (tramp-register-file-name-handlers)
+ (setq tramp-mode t)
+ (should (file-remote-p ert-remote-temporary-file-directory)))
+
+(ert-deftest tramp-test50-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -8106,6 +8184,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; `tramp-register-archive-file-name-handler' is autoloaded
;; in Emacs < 29.1.
(not (eq 'tramp-register-archive-file-name-handler x))
+ ;; `tramp-compat-rx' is autoloaded in Emacs 29.1.
+ (not (eq 'tramp-compat-rx x))
(not (string-match-p
(rx bol "tramp" (? "-archive") (** 1 2 "-") "test")
(symbol-name x)))
@@ -8167,12 +8247,10 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * file-name-case-insensitive-p
;; * memory-info
;; * tramp-get-home-directory
-;; * tramp-get-remote-gid
-;; * tramp-get-remote-groups
-;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
+;; * Use `skip-when' starting with Emacs 30.1.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for "ftp".
;; * Check, why a process filter t doesn't work in
@@ -8182,7 +8260,7 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct
;; async processes. Check, why they don't run stable.
;; * Check, why direct async processes do not work for
-;; `tramp-test44-asynchronous-requests'.
+;; `tramp-test45-asynchronous-requests'.
(provide 'tramp-tests)
diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el
index 42fa346a869..ffdebf2bb6f 100644
--- a/test/lisp/net/webjump-tests.el
+++ b/test/lisp/net/webjump-tests.el
@@ -58,7 +58,7 @@
(ert-deftest webjump-tests-url-fix ()
(should (equal (webjump-url-fix nil) ""))
(should (equal (webjump-url-fix "/tmp/") "file:///tmp/"))
- (should (equal (webjump-url-fix "gnu.org") "http://gnu.org/"))
+ (should (equal (webjump-url-fix "gnu.org") "https://gnu.org/"))
(should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/"))
(should (equal (webjump-url-fix "https://gnu.org")
"https://gnu.org/")))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 12:15:02 +0000