;; Return result.
(cdr tramp--test-enabled-checked))
-(defsubst tramp--test-expensive-test ()
- "Whether expensive tests are run."
- (ert-select-tests
- (ert--stats-selector ert--current-run-stats)
- (list (make-ert-test :name (ert-test-name (ert-running-test))
- :body nil :tags '(:expensive-test)))))
-
(defun tramp--test-make-temp-name (&optional local quoted)
"Return a temporary file name for test.
If LOCAL is non-nil, a local file name is returned.
"Check `file-exist-p', `write-region' and `delete-file'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
(delete-file tmp-name)
(should-not (file-exists-p tmp-name))
- ;; Trashing files doesn't work on MS Windows, and for crypted remote files.
- (unless (or (tramp--test-windows-nt-p) (tramp--test-crypt-p))
+ ;; Trashing files doesn't work when `system-move-file-to-trash'
+ ;; is defined (on MS Windows and macOS), and for crypted remote
+ ;; files.
+ (unless (or (fboundp 'system-move-file-to-trash) (tramp--test-crypt-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
"Check `file-local-copy'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
tmp-name2)
(unwind-protect
"Check `insert-file-contents'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(with-temp-buffer
"Check `write-region'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(inhibit-message t))
(unwind-protect
(skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
- (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted
+ (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
+ '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(with-temp-buffer
(insert-file-contents target)
(should (string-equal (buffer-string) "foo")))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(copy-file source target)
:type 'file-already-exists))
(make-directory target)
(should (file-directory-p target))
;; This has been changed in Emacs 26.1.
- (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
+ (when (and (tramp--test-expensive-test-p)
+ (tramp--test-emacs26-p))
(should-error
(copy-file source target)
:type 'file-already-exists)
(skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
- (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted
+ (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
+ '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil source)
(should (file-exists-p source))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(rename-file source target)
:type 'file-already-exists))
(make-directory target)
(should (file-directory-p target))
;; This has been changed in Emacs 26.1.
- (when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
+ (when (and (tramp--test-expensive-test-p)
+ (tramp--test-emacs26-p))
(should-error
(rename-file source target)
:type 'file-already-exists)
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo/bar" tmp-name1))
(unusual-file-mode-1 #o740)
"Check `delete-directory'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1)))
;; Delete empty directory.
(should-not (file-directory-p tmp-name1))
;; Trashing directories works only since Emacs 27.1. It doesn't
- ;; work on MS Windows, for crypted remote directories and for ange-ftp.
- (when (and (not (tramp--test-windows-nt-p)) (not (tramp--test-crypt-p))
- (not (tramp--test-ftp-p)) (tramp--test-emacs27-p))
+ ;; work when `system-move-file-to-trash' is defined (on MS
+ ;; Windows and macOS), for crypted 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))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
- (dolist (quoted (if (tramp--test-expensive-test) '(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 (expand-file-name
"Check `directory-files'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "bla" tmp-name1))
(tmp-name3 (expand-file-name "foo" tmp-name1)))
"Check `file-expand-wildcards'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tmp-name3 (expand-file-name "bar" tmp-name1))
;; Emacs 27.1.
(skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
;; Since Emacs 26.1.
(skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2
;; Relative file names in dired are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-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.
(should
(string-equal
(tramp-compat-file-attribute-type attr)
- (tramp-file-name-localname
- (tramp-dissect-file-name tmp-name3))))
+ (funcall
+ (if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity)
+ (tramp-file-name-localname
+ (tramp-dissect-file-name tmp-name3)))))
(delete-file tmp-name2))
(when test-file-ownership-preserved-p
"Check `directory-files-and-attributes'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; `directory-files-and-attributes' contains also values for
;; "../". Ensure that this doesn't change during tests, for
;; example due to handling temporary files.
(skip-unless (tramp--test-enabled))
(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-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)))
(should (= (file-modes tmp-name1) #o444))
(should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
- (unless (zerop (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name1)))
+ (unless (or (zerop (tramp-compat-file-attribute-user-id
+ (file-attributes tmp-name1)))
+ (tramp--test-sshfs-p))
(should-not (file-writable-p tmp-name1)))
;; Check the NOFOLLOW arg. It exists since Emacs 28. For
;; regular files, there shouldn't be a difference.
;; older Emacsen, therefore.
(skip-unless (tramp--test-emacs26-p))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-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.
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
;; A number means interactive case.
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
;; Check directory as newname.
(make-directory tmp-name4)
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name4)
:type 'file-already-exists))
;; Check `add-name-to-file'.
(unwind-protect
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(tramp--test-ignore-add-name-to-file-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(string-equal
(file-truename tmp-name2)
(file-truename tmp-name3)))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name2))
:type tramp-file-missing))
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name3))
:type tramp-file-missing))
;; Detect cyclic symbolic links.
(unwind-protect
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
(or (tramp--test-adb-p) (tramp--test-gvfs-p)
(tramp--test-sh-p) (tramp--test-sudoedit-p)))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-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 nil quoted)))
"Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(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) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted
+ (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
+ '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(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) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted
+ (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
+ '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(unwind-protect
(dolist
(syntax
- (if (tramp--test-expensive-test)
+ (if (tramp--test-expensive-test-p)
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
(tramp-change-syntax orig-syntax))))
(dolist (non-essential '(nil t))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
"Check `load'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
(fnnd (file-name-nondirectory tmp-name))
(default-directory tramp-test-temporary-file-directory)
+ (buffer (get-buffer-create "*tramp-tests*"))
kill-buffer-query-functions)
(unwind-protect
(progn
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
- (with-temp-buffer
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (should (zerop (process-file "ls" nil t nil fnnd)))
- ;; "ls" could produce colorized output.
- (goto-char (point-min))
- (while
- (re-search-forward tramp-display-escape-sequence-regexp nil t)
- (replace-match "" nil nil))
- (should (string-equal (format "%s\n" fnnd) (buffer-string)))
- (should-not (get-buffer-window (current-buffer) t))
+ ;; Check DESTINATION.
+ (dolist (destination `(nil t ,buffer))
+ (when (bufferp destination)
+ (with-current-buffer destination
+ (delete-region (point-min) (point-max))))
+ (with-temp-buffer
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (should (zerop (process-file "ls" nil destination nil fnnd)))
+ (with-current-buffer
+ (if (bufferp destination) destination (current-buffer))
+ ;; "ls" could produce colorized output.
+ (goto-char (point-min))
+ (while (re-search-forward
+ tramp-display-escape-sequence-regexp nil t)
+ (replace-match "" nil nil))
+ (should
+ (string-equal (if destination (format "%s\n" fnnd) "")
+ (buffer-string)))
+ (should-not (get-buffer-window (current-buffer) t))
+ (goto-char (point-max)))
+
+ ;; Second run. The output must be appended.
+ (should (zerop (process-file "ls" nil destination t fnnd)))
+ (with-current-buffer
+ (if (bufferp destination) destination (current-buffer))
+ ;; "ls" could produce colorized output.
+ (goto-char (point-min))
+ (while (re-search-forward
+ tramp-display-escape-sequence-regexp nil t)
+ (replace-match "" nil nil))
+ (should
+ (string-equal
+ (if destination (format "%s\n%s\n" fnnd fnnd) "")
+ (buffer-string))))
- ;; Second run. The output must be appended.
- (goto-char (point-max))
- (should (zerop (process-file "ls" nil t t fnnd)))
- ;; "ls" could produce colorized output.
- (goto-char (point-min))
- (while
- (re-search-forward tramp-display-escape-sequence-regexp nil t)
- (replace-match "" nil nil))
- (should
- (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
- ;; A non-nil DISPLAY must not raise the buffer.
- (should-not (get-buffer-window (current-buffer) t))))
+ (unless (eq destination t)
+ (should (string-empty-p (buffer-string))))
+ ;; A non-nil DISPLAY must not raise the buffer.
+ (should-not (get-buffer-window (current-buffer) t))
+ (delete-file tmp-name)))
+
+ ;; Check remote and local INFILE.
+ (dolist (local '(nil t))
+ (with-temp-buffer
+ (setq tmp-name (tramp--test-make-temp-name local quoted))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (should (zerop (process-file "cat" tmp-name t)))
+ (should (string-equal "foo" (buffer-string)))
+ (should-not (get-buffer-window (current-buffer) t))
+ (delete-file tmp-name)))
+
+ ;; Check remote and local DESTNATION file. This isn't
+ ;; implemented yet ina all file name handler backends.
+ ;; (dolist (local '(nil t))
+ ;; (setq tmp-name (tramp--test-make-temp-name local quoted))
+ ;; (should
+ ;; (zerop (process-file "echo" nil `(:file ,tmp-name) nil "foo")))
+ ;; (with-temp-buffer
+ ;; (insert-file-contents tmp-name)
+ ;; (should (string-equal "foo" (buffer-string)))
+ ;; (should-not (get-buffer-window (current-buffer) t))
+ ;; (delete-file tmp-name)))
+
+ ;; Check remote and local STDERR.
+ (dolist (local '(nil t))
+ (setq tmp-name (tramp--test-make-temp-name local quoted))
+ (should-not
+ (zerop
+ (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should
+ (string-match-p
+ "cat:.* No such file or directory" (buffer-string)))
+ (should-not (get-buffer-window (current-buffer) t))
+ (delete-file tmp-name))))
;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
(ignore-errors (delete-file tmp-name))))))
;; Must be a command, because used as `sigusr1' handler.
(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
- :tags '(:expensive-test)
+ :tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
;; Cleanup.
(ignore-errors (delete-process proc)))
- ;; "telnet" and "sshfs" do not cooperate with disabled filter.
- (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
+ ;; Disabled process filter. "sshfs" does not cooperate.
+ (unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test3" (current-buffer) "cat"))
(set-process-filter proc t)
(process-send-string proc "foo\n")
(process-send-eof proc)
- ;; Read output.
- (with-timeout (10 (tramp--test-timeout-handler))
+ ;; Read output. There shouldn't be any.
+ (with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
;; No output due to process filter.
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
,docstring
- :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
+ :tags (append '(:expensive-test :tramp-asynchronous-processes)
+ (and ,unstable '(:unstable)))
(skip-unless (tramp--test-enabled))
(let ((default-directory tramp-test-temporary-file-directory)
(ert-test (ert-get-test ',test))
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
- :tags '(:expensive-test)
+ :tags (append '(:expensive-test :tramp-asynchronous-processes)
+ (and (getenv "EMACS_EMBA_CI")
+ '(: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) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
;; Cleanup.
(ignore-errors (delete-process proc)))
- ;; "telnet" and "sshfs" do not cooperate with disabled filter.
- (unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
+ ;; Disabled process filter. "sshfs" does not cooperate.
+ (unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
(setq proc
(should (equal (process-status proc) 'run))
(process-send-string proc "foo\n")
(process-send-eof proc)
- ;; Read output.
- (with-timeout (10 (tramp--test-timeout-handler))
+ ;; Read output. There shouldn't be any.
+ (with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
;; No output due to process filter.
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
- :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
- '(:expensive-test :unstable) '(:expensive-test))
+ :tags (append '(:expensive-test :tramp-asynchronous-processes)
+ (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
+ '(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(default-directory tramp-test-temporary-file-directory)
;; Suppress nasty messages.
kill-buffer-query-functions)
(dolist (this-shell-command
- '(;; Synchronously.
- shell-command
- ;; Asynchronously.
- tramp--test-async-shell-command))
+ (append
+ ;; Synchronously.
+ '(shell-command)
+ ;; Asynchronously.
+ (and (tramp--test-asynchronous-processes-p)
+ '(tramp--test-async-shell-command))))
;; Test ordinary `{async-}shell-command'.
(unwind-protect
(ignore-errors (kill-buffer stderr))))))
;; Test sending string to `async-shell-command'.
- (unwind-protect
- (with-temp-buffer
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (tramp--test-async-shell-command
- "read line; ls $line" (current-buffer) nil
- ;; String to be sent.
- (format "%s\n" (file-name-nondirectory tmp-name)))
- (should
- (string-equal
- ;; tramp-adb.el echoes, so we must add the string.
- (if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
- (format
- "%s\n%s\n"
- (file-name-nondirectory tmp-name)
- (file-name-nondirectory tmp-name))
- (format "%s\n" (file-name-nondirectory tmp-name)))
- (buffer-string))))
+ (when (tramp--test-asynchronous-processes-p)
+ (unwind-protect
+ (with-temp-buffer
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (tramp--test-async-shell-command
+ "read line; ls $line" (current-buffer) nil
+ ;; String to be sent.
+ (format "%s\n" (file-name-nondirectory tmp-name)))
+ (should
+ (string-equal
+ ;; tramp-adb.el echoes, so we must add the string.
+ (if (and (tramp--test-adb-p)
+ (not (tramp-direct-async-process-p)))
+ (format
+ "%s\n%s\n"
+ (file-name-nondirectory tmp-name)
+ (file-name-nondirectory tmp-name))
+ (format "%s\n" (file-name-nondirectory tmp-name)))
+ (buffer-string))))
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name)))))
+ ;; 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-sh-p) (tramp--test-emacs27-p))
+ (when (and (tramp--test-asynchronous-processes-p)
+ (tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
(default-directory tramp-test-temporary-file-directory)
(cols (ignore-errors
(skip-unless (not (tramp--test-crypt-p)))
(dolist (this-shell-command-to-string
- '(;; Synchronously.
- shell-command-to-string
- ;; Asynchronously.
- tramp--test-shell-command-to-string-asynchronously))
+ (append
+ ;; Synchronously.
+ '(shell-command-to-string)
+ ;; Asynchronously.
+ (and (tramp--test-asynchronous-processes-p)
+ '(tramp--test-shell-command-to-string-asynchronously))))
(let ((default-directory tramp-test-temporary-file-directory)
(shell-file-name "/bin/sh")
;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test34-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
- :tags '(:expensive-test)
+ :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
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
;; process.
"Check `make-auto-save-file-name'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
tramp-allow-unsafe-temporary-files)
"Check `find-backup-file-name'."
(skip-unless (tramp--test-enabled))
- (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(ange-ftp-make-backup-files t)
;; `lock-file', `unlock-file', `file-locked-p' and
;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
;; see compiler warnings for older Emacsen.
- (dolist (quoted (if (tramp--test-expensive-test) '(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))
(remote-file-name-inhibit-cache t)
(ignore-errors (delete-file tmp-name1))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
+;; The functions were introduced in Emacs 28.1.
+(ert-deftest tramp-test39-detect-external-change ()
+ "Check that an external file modification is reported."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; Since Emacs 28.1.
+ (skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p)))
+
+ (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
+ (dolist (create-lockfiles '(nil t))
+ (let ((tmp-name (tramp--test-make-temp-name nil quoted))
+ (remote-file-name-inhibit-cache t)
+ (remote-file-name-inhibit-locks nil)
+ tramp-allow-unsafe-temporary-files
+ (inhibit-message t)
+ ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
+ (tramp-fuse-unmount-on-cleanup t)
+ auto-save-default
+ (backup-inhibited t)
+ noninteractive)
+ (with-temp-buffer
+ (unwind-protect
+ (progn
+ (setq buffer-file-name tmp-name
+ buffer-file-truename tmp-name)
+ (insert "foo")
+ ;; Bug#53207: with `create-lockfiles' nil, saving the
+ ;; buffer results in a prompt.
+ (cl-letf (((symbol-function 'yes-or-no-p)
+ (lambda (_) (ert-fail "Test failed unexpectedly"))))
+ (save-buffer))
+ (should-not (file-locked-p tmp-name))
+
+ ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
+ (with-no-warnings (when (symbol-plist 'ert-with-message-capture)
+ ;; For local files, just changing the file
+ ;; modification on disk doesn't hurt, because file
+ ;; contents in buffer and on disk are equal. For
+ ;; remote files, file contents is not compared. We
+ ;; mock an older modification time in buffer,
+ ;; because Tramp regards modification times equal if
+ ;; they differ for less than 2 seconds.
+ (set-visited-file-modtime (time-add (current-time) -60))
+ ;; Some Tramp methods cannot check the file
+ ;; modification time properly, for them it doesn't
+ ;; make sense to test.
+ (when (not (verify-visited-file-modtime))
+ (cl-letf (((symbol-function 'read-char-choice)
+ (lambda (prompt &rest _) (message "%s" prompt) ?y)))
+ (ert-with-message-capture captured-messages
+ (insert "bar")
+ (when create-lockfiles
+ (should (string-match-p
+ (format
+ "^%s changed on disk; really edit the buffer\\?"
+ (if (tramp--test-crypt-p)
+ ".+" (file-name-nondirectory tmp-name)))
+ captured-messages))
+ (should (file-locked-p tmp-name)))))
+
+ ;; `save-buffer' removes the file lock.
+ (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always)
+ ((symbol-function 'read-char-choice)
+ (lambda (&rest _) ?y)))
+ (save-buffer))
+ (should-not (file-locked-p tmp-name))))))
+
+ ;; Cleanup.
+ (set-buffer-modified-p nil)
+ (ignore-errors (delete-file tmp-name))
+ (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'."
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-ftp-file-name-handler))
+(defun tramp--test-asynchronous-processes-p ()
+ "Whether asynchronous processes tests are run.
+This is used in tests which we dont't want to tag
+`:tramp-asynchronous-processes' completely."
+ (and
+ (ert-select-tests
+ (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.
+ (not (and (tramp--test-adb-p)
+ (string-match-p "[[:multibyte:]]" default-directory)))))
+
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is crypted."
(tramp-crypt-file-name-p tramp-test-temporary-file-directory))
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-expensive-test-p ()
+ "Whether expensive tests are run.
+This is used in tests which we dont't want to tag `:expensive'
+completely."
+ (ert-select-tests
+ (ert--stats-selector ert--current-run-stats)
+ (list (make-ert-test :name (ert-test-name (ert-running-test))
+ :body nil :tags '(:expensive-test)))))
+
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
(file-truename tramp-test-temporary-file-directory)
- (tramp-check-remote-uname tramp-test-vec "^HP-UX"))
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX")))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
"Check, whether the remote host runs macOS."
;; We must refill the cache. `file-truename' does it.
(file-truename tramp-test-temporary-file-directory)
- (tramp-check-remote-uname tramp-test-vec "Darwin"))
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec "Darwin")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
- (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
- '(nil t) '(nil)))
+ (dolist (quoted
+ (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
+ '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
(delete-file file3)
(should-not (file-exists-p file3))))
+ ;; Check, that a process runs on a remote
+ ;; `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)))
+ (let ((default-directory file1))
+ (dolist (this-shell-command
+ (append
+ ;; Synchronously.
+ '(shell-command)
+ ;; Asynchronously.
+ (and (tramp--test-asynchronous-processes-p)
+ '(tramp--test-async-shell-command))))
+ (with-temp-buffer
+ (funcall this-shell-command "cat -- *" (current-buffer))
+ (should (string-equal elt (buffer-string)))))))
+
(delete-file file2)
(should-not (file-exists-p file2))
(delete-directory file1)
;; Check, that environment variables are set correctly.
;; We do not run on macOS due to encoding problems. See
;; Bug#36940.
- (when (and (tramp--test-expensive-test) (tramp--test-sh-p)
+ (when (and (tramp--test-expensive-test-p) (tramp--test-sh-p)
(not (tramp--test-crypt-p))
(not (eq system-type 'darwin)))
(dolist (elt files)
(unless (or (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
- "*foo*bar*baz*")
+ "*foo+bar*baz+")
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"'foo'bar'baz'"
"'foo\"bar'baz\"")
"{foo}bar{baz}")))
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
- (if (tramp--test-expensive-test)
+ (if (tramp--test-expensive-test-p)
files (list (mapconcat #'identity files ""))))))
;; These tests are inspired by Bug#17238.
;; to U+1FFFF).
"🌈🍒👋")
- (when (tramp--test-expensive-test)
+ (when (tramp--test-expensive-test-p)
(delete-dups
(mapcar
;; Use all available language specific snippets.
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
- :tags (if (getenv "EMACS_EMBA_CI")
- '(:expensive-test :unstable) '(:expensive-test))
+ :tags (append '(:expensive-test :tramp-asynchronous-processes)
+ (and (or (getenv "EMACS_HYDRA_CI")
+ (getenv "EMACS_EMBA_CI"))
+ '(:unstable)))
(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
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
- (skip-unless noninteractive)
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
(skip-unless (tramp--test-emacs26-p))
(should (featurep 'tramp-archive))
;; This unloads also tramp-archive.el and tramp-theme.el if needed.
(unload-feature 'tramp 'force)
- ;; No Tramp feature must be left.
+
+ ;; No Tramp feature must be left except the test packages.
(should-not (featurep 'tramp))
(should-not (featurep 'tramp-archive))
(should-not (featurep 'tramp-theme))
(should-not
(all-completions
"tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features))))
+
;; `file-name-handler-alist' must be clean.
(should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist)))
+
;; There shouldn't be left a bound symbol, except buffer-local
- ;; variables, and autoload functions. We do not regard our test
+ ;; variables, and autoloaded functions. We do not regard our test
;; symbols, and the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
- (and (functionp x) (null (autoloadp (symbol-function x)))))
+ (and (functionp x) (null (autoloadp (symbol-function x))))
+ (macrop x))
(string-match-p "^tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
(not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
(not (string-match-p "unload-hook$" (symbol-name x)))
+ (not (get x 'tramp-autoload))
(ert-fail (format "`%s' still bound" x)))))
+
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
(should-not (cl--find-class 'tramp-file-name))
(and (functionp x)
(string-match-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
+
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
(not (string-match-p "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
- (ert-fail (format "Hook `%s' still contains Tramp function" x))))))
+ (ert-fail (format "Hook `%s' still contains Tramp function" x)))))
+
+ ;; There shouldn't be left an advice function from Tramp.
+ (mapatoms
+ (lambda (x)
+ (and (functionp x)
+ (advice-mapc
+ (lambda (fun _symbol)
+ (and (string-match-p "^tramp" (symbol-name fun))
+ (ert-fail
+ (format "Function `%s' still contains Tramp advice" x))))
+ x))))
+
+ ;; Reload.
+ (require 'tramp)
+ (require 'tramp-archive)
+ (should (featurep 'tramp))
+ (should (featurep 'tramp-archive)))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp].
projects / emacs.git / commitdiff