diff options
Diffstat (limited to 'test/lisp/net/tramp-tests.el')
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 222 |
1 files changed, 118 insertions, 104 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3216a8be1b0..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -134,7 +134,7 @@ A resource file is in the resource directory as per (eval-and-compile ;; There is no default value on w32 systems, which could work out ;; of the box. - (defconst ert-remote-temporary-file-directory + (defvar ert-remote-temporary-file-directory (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) ((eq system-type 'windows-nt) null-device) @@ -265,8 +265,8 @@ is greater than 10. `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) (debug-ignored-errors (append - '("^make-symbolic-link not supported$" - "^error with add-name-to-file") + '("\\`make-symbolic-link not supported\\'" + "\\`error with add-name-to-file") debug-ignored-errors)) inhibit-message) (unwind-protect @@ -379,7 +379,7 @@ is greater than 10. (let (tramp-mode) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; `tramp-ignored-file-name-regexp' suppresses Tramp. - (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) + (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; Methods shall be at least two characters, except the ;; default method. @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (not (tramp--test-rsync-p))) ;; Wildcards are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) + ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". + (skip-unless (not (tramp--test-container-oob-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3815,15 +3817,24 @@ This tests also `access-file', `file-readable-p', (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) +(defun tramp--test-set-ert-test-documentation (test command) + "Set the documentation string for a derived test. +The test is derived from TEST and COMMAND." + (let ((test-doc + (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) + ;; The first line must be extended. + (setcar + test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) + (setf (ert-test-documentation + (get (intern (format "%s-with-%s" test command)) 'ert--test)) + (string-join test-doc "\n")))) + (defmacro tramp--test-deftest-with-stat (test) "Define ert `TEST-with-stat'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () - ;; 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 the \"stat\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "stat") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-stat tramp-test-vec)) @@ -3842,11 +3853,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-perl'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () - ;; 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 the \"perl\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "perl") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-perl tramp-test-vec)) @@ -3870,11 +3878,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-ls'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () - ;; 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 the \"ls\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "ls") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (if-let ((default-directory ert-remote-temporary-file-directory) @@ -4719,57 +4724,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) - ;; Method and host name in completion mode. This kind of completion - ;; does not work on MS Windows. - (unless (memq system-type '(cygwin windows-nt)) - (let ((tramp-fuse-remove-hidden-files t) - (method (file-remote-p ert-remote-temporary-file-directory 'method)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax) - (minibuffer-completing-file-name t)) - (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) - (setq host (match-string 1 host))) + ;; Method and host name in completion mode. + (let ((tramp-fuse-remove-hidden-files t) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) - (unwind-protect - (dolist (syntax (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 - ;; for completion. We must refill the cache. - (tramp-set-connection-property tramp-test-vec "property" nil) - - (let (;; This is needed for the `separate' syntax. - (prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) - ;; Complete method name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp)) - (should - (member - (concat prefix-format method tramp-postfix-method-format) - (file-name-all-completions - (concat prefix-format (substring method 0 1)) "/")))) - ;; Complete host name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp) - (tramp-string-empty-or-nil-p host)) - (should - (member - (concat - prefix-format method tramp-postfix-method-format - ipv6-prefix host ipv6-postfix tramp-postfix-host-format) - (file-name-all-completions - (concat prefix-format method tramp-postfix-method-format) - "/")))))) + (unwind-protect + (dolist (syntax (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 + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) - ;; Cleanup. - (tramp-change-syntax orig-syntax)))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) + ;; Complete method name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) + (should + (member + (concat prefix-format method tramp-postfix-method-format) + (file-name-all-completions + (concat prefix-format (substring method 0 1)) "/")))) + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) + (should + (member + (concat + prefix-format method tramp-postfix-method-format + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + (file-name-all-completions + (concat prefix-format method tramp-postfix-method-format) + "/")))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))) (dolist (non-essential '(nil t)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) @@ -4851,9 +4854,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." - ;; Method, user and host name in completion mode. This kind of - ;; completion does not work on MS Windows. - (skip-unless (not (memq system-type '(cygwin windows-nt)))) + ;; Method, user and host name in completion mode. (tramp-cleanup-connection tramp-test-vec nil 'keep-password) (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) @@ -5159,8 +5160,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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. + ;; Check remote and local DESTINATION file. This isn't + ;; implemented yet in all file name handler backends. ;; (dolist (local '(nil t)) ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) ;; (should @@ -6380,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." (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< (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 - (append - tramp-remote-path `(,(file-remote-p dir 'localname))) - orig-exec-path - (append - (butlast orig-exec-path) - `(,(file-remote-p dir 'localname)) - (last orig-exec-path))))) - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (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. - (unless (tramp-compat-length> - path - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) - ;; The last element of `exec-path' is `exec-directory'. - (should - (string-equal path (string-join (butlast orig-exec-path) ":")))) - ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote))) + (unless (tramp--test-container-oob-p) + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (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 + (append + tramp-remote-path `(,(file-remote-p dir 'localname))) + orig-exec-path + (append + (butlast orig-exec-path) + `(,(file-remote-p dir 'localname)) + (last orig-exec-path))))) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (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. + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) + ;; The last element of `exec-path' is `exec-directory'. + (should + (string-equal path (string-join (butlast orig-exec-path) ":")))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -7057,17 +7060,24 @@ This is used in tests which we don't want to tag (not (and (tramp--test-adb-p) (string-match-p (rx multibyte) default-directory))))) -(defun tramp--test-crypt-p () - "Check, whether the remote directory is encrypted." - (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) - (defun tramp--test-container-p () "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman") eol) + (rx bol (| "docker" "podman")) + (file-remote-p ert-remote-temporary-file-directory 'method))) + +(defun tramp--test-container-oob-p () + "Check, whether the dockercp or podmancp method is used. +They does not support wildcard copy." + (string-match-p + (rx bol (| "dockercp" "podmancp") eol) (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-crypt-p () + "Check, whether the remote directory is encrypted." + (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) + (defun tramp--test-expensive-test-p () "Whether expensive tests are run. This is used in tests which we don't want to tag `:expensive' @@ -7484,7 +7494,8 @@ This requires restrictions of file name syntax." (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "*foo+bar*baz+") @@ -7504,7 +7515,10 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "<foo>bar<baz>") "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) + (tramp--test-gvfs-p)) + "[foo]bar[baz]") "{foo}bar{baz}"))) ;; Simplify test in order to speed up. (apply #'tramp--test-check-files |