diff options
Diffstat (limited to 'test/lisp/net')
| -rw-r--r-- | test/lisp/net/eww-tests.el | 247 | ||||
| -rw-r--r-- | test/lisp/net/shr-resources/blockquote.html | 2 | ||||
| -rw-r--r-- | test/lisp/net/shr-resources/blockquote.txt | 3 | ||||
| -rw-r--r-- | test/lisp/net/shr-tests.el | 72 | ||||
| -rw-r--r-- | test/lisp/net/tramp-archive-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 222 |
6 files changed, 424 insertions, 126 deletions
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el new file mode 100644 index 00000000000..b83435e0bd9 --- /dev/null +++ b/test/lisp/net/eww-tests.el @@ -0,0 +1,247 @@ +;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'eww) + +(defvar eww-test--response-function (lambda (url) (concat "\n" url)) + "A function for returning a mock response for URL. +The default just returns an empty list of headers and the URL as the +body.") + +(defmacro eww-test--with-mock-retrieve (&rest body) + "Evaluate BODY with a mock implementation of `eww-retrieve'. +This avoids network requests during our tests. Additionally, prepare a +temporary EWW buffer for our tests." + (declare (indent 0)) + `(cl-letf (((symbol-function 'eww-retrieve) + (lambda (url callback args) + (with-temp-buffer + (insert (funcall eww-test--response-function url)) + (apply callback nil args))))) + (with-temp-buffer + (eww-mode) + ,@body))) + +(defun eww-test--history-urls () + (mapcar (lambda (elem) (plist-get elem :url)) eww-history)) + +;;; Tests: + +(ert-deftest eww-test/display/html () + "Test displaying a simple HTML page." + (eww-test--with-mock-retrieve + (let ((eww-test--response-function + (lambda (url) + (concat "Content-Type: text/html\n\n" + (format "<html><body><h1>Hello</h1>%s</body></html>" + url))))) + (eww "example.invalid") + ;; Check that the buffer contains the rendered HTML. + (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n")) + (should (equal (get-text-property (point-min) 'face) + '(shr-text shr-h1))) + ;; Check that the DOM includes the `base'. + (should (equal (pcase (plist-get eww-data :dom) + (`(base ((href . ,url)) ,_) url)) + "http://example.invalid/"))))) + +(ert-deftest eww-test/history/new-page () + "Test that when visiting a new page, the previous one goes into the history." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (should (equal (eww-test--history-urls) + '("http://one.invalid/"))) + (eww "three.invalid") + (should (equal (eww-test--history-urls) + '("http://two.invalid/" + "http://one.invalid/"))))) + +(ert-deftest eww-test/history/back-forward () + "Test that navigating through history just changes our history position. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (let ((url-history '("http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + ;; Go back one page. This should add "three.invalid" to the + ;; history, making our position in the list 2. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go back again. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 3)) + ;; At the beginning of the history, so trying to go back should + ;; signal an error. + (should-error (eww-back-url)) + ;; Go forward once. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go forward again. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 1)) + ;; At the end of the history, so trying to go forward should + ;; signal an error. + (should-error (eww-forward-url))))) + +(ert-deftest eww-test/history/reload-in-place () + "Test that reloading historical pages updates their history entry in-place. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + ;; Make sure our history has the original page text. + (should (equal (plist-get (nth 1 eww-history) :text) + "http://two.invalid/")) + (should (= eww-history-position 2)) + ;; Reload the page. + (let ((eww-test--response-function + (lambda (url) (concat "\nreloaded " url)))) + (eww-reload) + (should (= eww-history-position 2))) + ;; Go to another page, and make sure the history is correct, + ;; including the reloaded page text. + (eww "four.invalid") + (should (equal (eww-test--history-urls) '("http://two.invalid/" + "http://one.invalid/"))) + (should (equal (plist-get (nth 0 eww-history) :text) + "reloaded http://two.invalid/")) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/delete-future-history () + "Test that going to a new page from a historical one deletes future history. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/ignore-history () + "Test that going to a new page from a historical one preserves history. +This sets `eww-before-browse-history-function' to `ignore' to preserve +history. See bug#69232." + (let ((eww-before-browse-history-function #'ignore)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/history/before-navigate/clone-previous () + "Test that going to a new page from a historical one clones prior history. +This sets `eww-before-browse-history-function' to +`eww-clone-previous-history' to clone the history. See bug#69232." + (let ((eww-before-browse-history-function #'eww-clone-previous-history)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) + '(;; New page and cloned history. + "http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/" + ;; Original history. + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/readable/toggle-display () + "Test toggling the display of the \"readable\" parts of a web page." + (eww-test--with-mock-retrieve + (let* ((shr-width most-positive-fixnum) + (shr-use-fonts nil) + (words (string-join + (make-list + 20 "All work and no play makes Jack a dull boy.") + " ")) + (eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "<html><body>" + "<a>This is an uninteresting sentence.</a>" + "<div>" + words + "</div>" + "</body></html>")))) + (eww "example.invalid") + ;; Make sure EWW renders the whole document. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Now, EWW should render just the "readable" parts. + (should (plist-get eww-data :readable)) + (should (string-match-p + (concat "\\`" (regexp-quote words) "\n*\\'") + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Finally, EWW should render the whole document again. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max))))))) + +(ert-deftest eww-test/readable/default-readable () + "Test that EWW displays readable parts of pages by default when applicable." + (eww-test--with-mock-retrieve + (let* ((eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "<html><body>Hello there</body></html>"))) + (eww-readable-urls '("://example\\.invalid/"))) + (eww "example.invalid") + ;; Make sure EWW uses "readable" mode. + (should (plist-get eww-data :readable))))) + +(provide 'eww-tests) +;; eww-tests.el ends here diff --git a/test/lisp/net/shr-resources/blockquote.html b/test/lisp/net/shr-resources/blockquote.html new file mode 100644 index 00000000000..412caf8bae6 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.html @@ -0,0 +1,2 @@ +<blockquote>Citation.</blockquote> +<div>Reply.</div> diff --git a/test/lisp/net/shr-resources/blockquote.txt b/test/lisp/net/shr-resources/blockquote.txt new file mode 100644 index 00000000000..8ed610b8ea2 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.txt @@ -0,0 +1,3 @@ + Citation. + +Reply. diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 0c6e2c091bf..17138053450 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -29,30 +29,62 @@ (declare-function libxml-parse-html-region "xml.c") -(defun shr-test (name) - (with-temp-buffer - (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) - (let ((dom (libxml-parse-html-region (point-min) (point-max))) - (shr-width 80) - (shr-use-fonts nil)) - (erase-buffer) - (shr-insert-document dom) - (cons (buffer-substring-no-properties (point-min) (point-max)) - (with-temp-buffer - (insert-file-contents - (format (concat (ert-resource-directory) "/%s.txt") name)) - (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) - (replace-match (string (string-to-number (match-string 1) 16)) - t t)) - (buffer-string)))))) +(defun shr-test--rendering-check (name &optional context) + "Render NAME.html and compare it to NAME.txt. +Raise a test failure if the rendered buffer does not match NAME.txt. +Append CONTEXT to the failure data, if non-nil." + (let ((text-file (file-name-concat (ert-resource-directory) (concat name ".txt"))) + (html-file (file-name-concat (ert-resource-directory) (concat name ".html"))) + (description (if context (format "%s (%s)" name context) name))) + (with-temp-buffer + (insert-file-contents html-file) + (let ((dom (libxml-parse-html-region (point-min) (point-max))) + (shr-width 80) + (shr-use-fonts nil)) + (erase-buffer) + (shr-insert-document dom) + (let ((result (buffer-substring-no-properties (point-min) (point-max))) + (expected + (with-temp-buffer + (insert-file-contents text-file) + (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) + (replace-match (string (string-to-number (match-string 1) 16)) + t t)) + (buffer-string)))) + (unless (equal result expected) + (ert-fail (list description result expected)))))))) + +(defconst shr-test--rendering-extra-configs + '(("blockquote" + ;; Make sure blockquotes remain indented even when filling is + ;; disabled (bug#69555). + . ((shr-fill-text . nil)))) + "Extra customizations which can impact rendering. +This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a +set of txt/html files under shr-resources/, as passed to `shr-test'. +SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to +validate for the NAME testcase. + +The `rendering' testcase will test NAME once without altering any +settings, then once more for each (OPTION . VALUE) pair.") (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) - (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) - (result (shr-test name))) - (unless (equal (car result) (cdr result)) - (should (not (list name (car result) (cdr result)))))))) + (let* ((name (string-remove-suffix ".html" file)) + (extra-options (alist-get name shr-test--rendering-extra-configs + nil nil 'string=))) + ;; Test once with default settings. + (shr-test--rendering-check name) + ;; Test once more for every extra option for this specific NAME. + (pcase-dolist (`(,option-sym ,option-val) + extra-options) + (let ((option-old (symbol-value option-sym))) + (set option-sym option-val) + (unwind-protect + (shr-test--rendering-check + name (format "with %s %s" option-sym option-val)) + (set option-sym option-old))))))) (ert-deftest use-cookies () (let ((shr-cookie-policy 'same-origin)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 978342b1bb1..1ca2fa9b9b3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -77,7 +77,7 @@ A resource file is in the resource directory as per `ert-resource-directory'." `(expand-file-name ,file (ert-resource-directory))))) -(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") +(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") (defun tramp-archive-test-file-archive-hexlified () @@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) (url-hexify-string tramp-archive-test-file-archive))) -(defconst tramp-archive-test-archive +(defvar tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") 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 |