procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Adapt Tramp tests

Browse source 
* test/lisp/net/tramp-archive-tests.el (tramp-archive-test45-auto-load):
Adapt code snippet.

* test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
(tramp-test30-make-process): Adapt tests.
(tramp--test-supports-set-file-modes-p): Renamed from
`tramp--test-supports-file-modes-p'.  Adapt all callees.
(tramp-test35-exec-path): Use it.
This commit is contained in:
Michael Albinus 2021-10-20 18:14:00 +02:00
parent 1bb14f93f1
commit c916040921
2 changed files with 36 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
test/lisp/net/tramp-archive-tests.el
View file

@ -923,9 +923,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
"(progn \ "(progn \
(message \"tramp-archive loaded: %%s\" \ (message \"tramp-archive loaded: %%s\" \
(featurep 'tramp-archive)) \ (featurep 'tramp-archive)) \
(file-attributes %S \"/\") \ (let ((inhibit-message t)) \
(file-attributes %S \"/\")) \
(message \"tramp-archive loaded: %%s\" \ (message \"tramp-archive loaded: %%s\" \
(featurep 'tramp-archive)))")) (featurep 'tramp-archive))))"))
(dolist (default-directory (dolist (default-directory
`(,temporary-file-directory `(,temporary-file-directory
;; Starting Emacs in a directory which has ;; Starting Emacs in a directory which has

64
test/lisp/net/tramp-tests.el
View file

@ -2786,7 +2786,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
:type 'file-already-exists) :type 'file-already-exists)
(should (file-directory-p tmp-name1)) (should (file-directory-p tmp-name1))
(should (file-accessible-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1))
(when (tramp--test-supports-file-modes-p) (when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-1) (should (equal (format "%#o" unusual-file-mode-1)
(format "%#o" (file-modes tmp-name1))))) (format "%#o" (file-modes tmp-name1)))))
(should-error (should-error
@ -2796,7 +2796,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(make-directory tmp-name2 'parents)) (make-directory tmp-name2 'parents))
(should (file-directory-p tmp-name2)) (should (file-directory-p tmp-name2))
(should (file-accessible-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2))
(when (tramp--test-supports-file-modes-p) (when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-2) (should (equal (format "%#o" unusual-file-mode-2)
(format "%#o" (file-modes tmp-name2))))) (format "%#o" (file-modes tmp-name2)))))
;; If PARENTS is non-nil, `make-directory' shall not ;; If PARENTS is non-nil, `make-directory' shall not
@ -3160,7 +3160,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(length (directory-files tmp-name1))))))) (length (directory-files tmp-name1)))))))
;; Check error cases. ;; Check error cases.
(when (and (tramp--test-supports-file-modes-p) (when (and (tramp--test-supports-set-file-modes-p)
;; With "sshfs", directories with zero file ;; With "sshfs", directories with zero file
;; modes are still "accessible". ;; modes are still "accessible".
(not (tramp--test-sshfs-p)) (not (tramp--test-sshfs-p))
@ -3385,7 +3385,7 @@ This tests also `access-file', `file-readable-p',
(tramp-get-remote-gid tramp-test-vec 'integer))) (tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1)) (delete-file tmp-name1))
(when (and (tramp--test-supports-file-modes-p) (when (and (tramp--test-supports-set-file-modes-p)
;; A file is always accessible for user "root". ;; A file is always accessible for user "root".
(not (zerop (tramp-compat-file-attribute-user-id (not (zerop (tramp-compat-file-attribute-user-id
(file-attributes (file-attributes
@ -3628,7 +3628,8 @@ They might differ only in time attributes or directory size."
"Check `file-modes'. "Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-file-modes-p)) (skip-unless (tramp--test-supports-set-file-modes-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))) (tmp-name2 (tramp--test-make-temp-name nil quoted)))
@ -3963,7 +3964,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(make-symbolic-link tmp-name2 tmp-name1) (make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name1))
(if (tramp--test-smb-p) (if (tramp--test-smb-p)
;; The symlink command of `smbclient' detects the ;; The symlink command of "smbclient" detects the
;; cycle already. ;; cycle already.
(should-error (should-error
(make-symbolic-link tmp-name1 tmp-name2) (make-symbolic-link tmp-name1 tmp-name2)
@ -4074,6 +4075,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test24-file-acl () (ert-deftest tramp-test24-file-acl ()
"Check that `file-acl' and `set-file-acl' work proper." "Check that `file-acl' and `set-file-acl' work proper."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
;; The following test checks also whether `set-file-modes' will work.
(skip-unless (file-acl tramp-test-temporary-file-directory)) (skip-unless (file-acl tramp-test-temporary-file-directory))
(skip-unless (not (tramp--test-crypt-p))) (skip-unless (not (tramp--test-crypt-p)))
@ -4484,7 +4486,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(write-region "foo" nil tmp-name) (write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name)) (should (file-exists-p tmp-name))
(should (zerop (process-file "ls" nil t nil fnnd))) (should (zerop (process-file "ls" nil t nil fnnd)))
;; `ls' could produce colorized output. ;; "ls" could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (while
(re-search-forward tramp-display-escape-sequence-regexp nil t) (re-search-forward tramp-display-escape-sequence-regexp nil t)
@ -4495,7 +4497,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Second run. The output must be appended. ;; Second run. The output must be appended.
(goto-char (point-max)) (goto-char (point-max))
(should (zerop (process-file "ls" nil t t fnnd))) (should (zerop (process-file "ls" nil t t fnnd)))
;; `ls' could produce colorized output. ;; "ls" could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (while
(re-search-forward tramp-display-escape-sequence-regexp nil t) (re-search-forward tramp-display-escape-sequence-regexp nil t)
@ -4508,7 +4510,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-file tmp-name)))))) (ignore-errors (delete-file tmp-name))))))
;; Must be a command, because used as `sigusr' handler. ;; Must be a command, because used as `sigusr1' handler.
(defun tramp--test-timeout-handler (&rest _ignore) (defun tramp--test-timeout-handler (&rest _ignore)
"Timeout handler, reporting a failed test." "Timeout handler, reporting a failed test."
(interactive) (interactive)
@ -4588,8 +4590,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc))) (ignore-errors (delete-process proc)))
;; `telnet' does not cooperate with disabled filter. ;; "telnet" and "sshfs" do not cooperate with disabled filter.
(unless (tramp--test-telnet-p) (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
(unwind-protect (unwind-protect
(with-temp-buffer (with-temp-buffer
(setq proc (start-file-process "test3" (current-buffer) "cat")) (setq proc (start-file-process "test3" (current-buffer) "cat"))
@ -4638,7 +4640,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(if (and (memq process-connection-type '(nil pipe)) (if (and (memq process-connection-type '(nil pipe))
(not (tramp--test-macos-p))) (not (tramp--test-macos-p)))
;; On macOS, there is always newline conversion. ;; On macOS, there is always newline conversion.
;; `telnet' converts \r to <CR><NUL> if `crlf' ;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page. ;; flag is FALSE. See telnet(1) man page.
"66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
"66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
@ -4781,8 +4783,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc))) (ignore-errors (delete-process proc)))
;; `telnet' does not cooperate with disabled filter. ;; "telnet" and "sshfs" do not cooperate with disabled filter.
(unless (tramp--test-telnet-p) (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
(unwind-protect (unwind-protect
(with-temp-buffer (with-temp-buffer
(setq proc (setq proc
@ -4830,7 +4832,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc))) (ignore-errors (delete-process proc)))
;; Process with stderr buffer. `telnet' does not cooperate with ;; Process with stderr buffer. "telnet" does not cooperate with
;; three processes. ;; three processes.
(unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p)) (unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p))
(let ((stderr (generate-new-buffer "*stderr*"))) (let ((stderr (generate-new-buffer "*stderr*")))
@ -4930,7 +4932,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
'(nil pipe)) '(nil pipe))
(not (tramp--test-macos-p))) (not (tramp--test-macos-p)))
;; On macOS, there is always newline conversion. ;; On macOS, there is always newline conversion.
;; `telnet' converts \r to <CR><NUL> if `crlf' ;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page. ;; flag is FALSE. See telnet(1) man page.
"66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
"66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
@ -5034,7 +5036,7 @@ INPUT, if non-nil, is a string sent to the process."
this-shell-command this-shell-command
(format "ls %s" (file-name-nondirectory tmp-name)) (format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer)) (current-buffer))
;; `ls' could produce colorized output. ;; "ls" could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (while
(re-search-forward tramp-display-escape-sequence-regexp nil t) (re-search-forward tramp-display-escape-sequence-regexp nil t)
@ -5489,8 +5491,7 @@ Use direct async.")
(ert-deftest tramp-test35-exec-path () (ert-deftest tramp-test35-exec-path ()
"Check `exec-path' and `executable-find'." "Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) (skip-unless (tramp--test-supports-set-file-modes-p))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1. ;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path)) (skip-unless (fboundp 'exec-path))
@ -5511,6 +5512,7 @@ Use direct async.")
;; found. ;; found.
(write-region "foo" nil tmp-name) (write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name)) (should (file-exists-p tmp-name))
(set-file-modes tmp-name #o777) (set-file-modes tmp-name #o777)
(should (file-executable-p tmp-name)) (should (file-executable-p tmp-name))
(should (should
@ -6268,8 +6270,8 @@ This requires restrictions of file name syntax."
This requires restrictions of file name syntax." This requires restrictions of file name syntax."
(tramp-smb-file-name-p tramp-test-temporary-file-directory)) (tramp-smb-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-supports-file-modes-p () (defun tramp--test-supports-set-file-modes-p ()
"Return whether the method under test supports file modes." "Return whether the method under test supports setting file modes."
;; "smb" does not unless the SMB server supports "posix" extensions. ;; "smb" does not unless the SMB server supports "posix" extensions.
;; "adb" does not unless the Android device is rooted. ;; "adb" does not unless the Android device is rooted.
(or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p) (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
@ -6372,9 +6374,9 @@ This requires restrictions of file name syntax."
(kill-buffer buffer) (kill-buffer buffer)
;; `substitute-in-file-name' could return different ;; `substitute-in-file-name' could return different
;; values. For `adb', there could be strange file ;; values. For "adb", there could be strange file
;; permissions preventing overwriting a file. We don't ;; permissions preventing overwriting a file. We don't
;; care in this testcase. ;; care in this test case.
(dolist (elt files) (dolist (elt files)
(let ((file1 (let ((file1
(substitute-in-file-name (expand-file-name elt tmp-name1))) (substitute-in-file-name (expand-file-name elt tmp-name1)))
@ -6540,7 +6542,7 @@ This requires restrictions of file name syntax."
(ert-deftest tramp-test41-special-characters-with-stat () (ert-deftest tramp-test41-special-characters-with-stat ()
"Check special characters in file names. "Check special characters in file names.
Use the `stat' command." Use the \"stat\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -6559,7 +6561,7 @@ Use the `stat' command."
(ert-deftest tramp-test41-special-characters-with-perl () (ert-deftest tramp-test41-special-characters-with-perl ()
"Check special characters in file names. "Check special characters in file names.
Use the `perl' command." Use the \"perl\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -6581,7 +6583,7 @@ Use the `perl' command."
(ert-deftest tramp-test41-special-characters-with-ls () (ert-deftest tramp-test41-special-characters-with-ls ()
"Check special characters in file names. "Check special characters in file names.
Use the `ls' command." Use the \"ls\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -6663,7 +6665,7 @@ Use the `ls' command."
(ert-deftest tramp-test42-utf8-with-stat () (ert-deftest tramp-test42-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `stat' command." Use the \"stat\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -6686,7 +6688,7 @@ Use the `stat' command."
(ert-deftest tramp-test42-utf8-with-perl () (ert-deftest tramp-test42-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `perl' command." Use the \"perl\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -6712,7 +6714,7 @@ Use the `perl' command."
(ert-deftest tramp-test42-utf8-with-ls () (ert-deftest tramp-test42-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents. "Check UTF8 encoding in file names and file contents.
Use the `ls' command." Use the \"ls\" command."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -7185,8 +7187,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test06-directory-file-name' for "ftp".
;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and ;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and
;; for direct async processes. ;; for direct async processes.
;; * Check, why direct async processes do not work for ;; * Check, why direct async processes do not work for
;; `tramp-test44-asynchronous-requests'. ;; `tramp-test44-asynchronous-requests'.