diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 3de909911b4..a52b8be6e09 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -338,15 +338,16 @@ arguments to pass to the OPERATION." (tramp-register-file-name-handlers) (tramp-archive-run-real-handler operation args)) - (let* ((filename (apply #'tramp-archive-file-name-for-operation + (let* ((tramp-methods (cons `(,tramp-archive-method) tramp-methods)) + (tramp-gvfs-methods tramp-archive-all-gvfs-methods) + (filename (apply #'tramp-archive-file-name-for-operation operation args)) (archive (tramp-archive-file-name-archive filename))) ;; `filename' could be a quoted file name. Or the file ;; archive could be a directory, see Bug#30293. (if (or (null archive) - (not (tramp-archive-run-real-handler - #'file-exists-p (list archive))) + (not (file-exists-p archive)) (tramp-archive-run-real-handler #'file-directory-p (list archive))) (tramp-archive-run-real-handler operation args) @@ -358,9 +359,7 @@ arguments to pass to the OPERATION." (tramp-get-buffer (tramp-archive-dissect-file-name filename)) (setq default-directory (file-name-as-directory archive))) ;; Now run the handler. - (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods)) - (tramp-gvfs-methods tramp-archive-all-gvfs-methods) - ;; Set uid and gid. gvfsd-archive could do it, but it doesn't. + (let (;; Set uid and gid. gvfsd-archive could do it, but it doesn't. (tramp-unknown-id-integer (user-uid)) (tramp-unknown-id-string (user-login-name)) (fn (assoc operation tramp-archive-file-name-handler-alist))) diff --git a/test/lisp/net/tramp-archive-resources/outer.zip b/test/lisp/net/tramp-archive-resources/outer.zip new file mode 100644 index 00000000000..deda1013eb0 Binary files /dev/null and b/test/lisp/net/tramp-archive-resources/outer.zip differ diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 33dc0b9d4af..ec56c4a0f93 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -36,12 +36,6 @@ (defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") -(defun tramp-archive-test-file-archive-hexlified () - "Return hexlified `tramp-archive-test-file-archive'. -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))) - (defvar tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") @@ -50,11 +44,28 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." (file-truename (ert-resource-file "foo.iso")) "A directory file name, which looks like an archive.") +(defvar tramp-archive-test-cascaded-file-archive + (ert-resource-file "outer.zip/foo.tar.gz") + "The cascaded test file archive.") + +(defvar tramp-archive-test-cascaded-archive + (file-name-as-directory tramp-archive-test-cascaded-file-archive) + "The cascaded test archive.") + +(defun tramp-archive-test-file-archive-hexlified () + "Return hexlified `tramp-archive-test-file-archive'. +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))) + (setq password-cache-expiry nil tramp-cache-read-persistent-data t ;; For auth-sources. tramp-persistency-file-name nil tramp-verbose 0) +(defvar tramp-archive-test-cascaded nil + "Indicator, whether we are testing a cascaded archive.") + (defun tramp-archive--test-make-temp-name () "Return a temporary file name for test. The temporary file is not created." @@ -86,9 +97,29 @@ the origin of the temporary TMPFILE, have no write permissions." (file-exists-p tramp-archive-test-file-archive) (tramp-archive-file-name-p tramp-archive-test-archive)))) +;; These tests are inspired by Bug#79582. +(defmacro tramp-archive--test-deftest-cascaded (test) + "Define ert `TEST-cascaded'." + (declare (indent 1)) + `(ert-deftest ,(intern (concat (symbol-name test) "-cascaded")) () + :tags '(:expensive-test) + ;(tramp--test-set-ert-test-documentation ',test "cascaded") + (skip-unless tramp-archive-enabled) + (if-let* ((ert-test (ert-get-test ',test)) + (result (ert-test-most-recent-result ert-test)) + (tramp-archive-test-file-archive + tramp-archive-test-cascaded-file-archive) + (tramp-archive-test-archive tramp-archive-test-cascaded-archive) + (tramp-archive-test-cascaded t)) + (progn + (skip-unless (< (ert-test-result-duration result) 300)) + (funcall (ert-test-body ert-test))) + (ert-skip (format "Test `%s' must run before" ',test))))) + (ert-deftest tramp-archive-test01-file-name-syntax () "Check archive file name syntax." - (should-not (tramp-archive-file-name-p tramp-archive-test-file-archive)) + (unless tramp-archive-test-cascaded + (should-not (tramp-archive-file-name-p tramp-archive-test-file-archive))) (should (tramp-archive-file-name-p tramp-archive-test-archive)) (should (string-equal @@ -136,6 +167,8 @@ the origin of the temporary TMPFILE, have no write permissions." (concat tramp-archive-test-archive "baz.tar/")) "/"))) +(tramp-archive--test-deftest-cascaded tramp-archive-test01-file-name-syntax) + (ert-deftest tramp-archive-test02-file-name-dissect () "Check archive file name components." (skip-unless tramp-archive-enabled) @@ -250,10 +283,13 @@ the origin of the temporary TMPFILE, have no write permissions." (string-equal (expand-file-name (concat tramp-archive-test-archive "./file")) (concat tramp-archive-test-archive "file"))) - (should - (string-equal - (expand-file-name (concat tramp-archive-test-archive "../file")) - (concat (ert-resource-directory) "file")))) + (unless tramp-archive-test-cascaded + (should + (string-equal + (expand-file-name (concat tramp-archive-test-archive "../file")) + (concat (ert-resource-directory) "file"))))) + +(tramp-archive--test-deftest-cascaded tramp-archive-test05-expand-file-name) ;; This test is inspired by Bug#30293. (ert-deftest tramp-archive-test05-expand-file-name-non-archive-directory () @@ -332,6 +368,8 @@ This checks also `file-name-as-directory', `file-name-directory', (unhandled-file-name-directory (concat tramp-archive-test-archive "path/to/file")))) +(tramp-archive--test-deftest-cascaded tramp-archive-test06-directory-file-name) + (ert-deftest tramp-archive-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." :tags '(:expensive-test) @@ -355,6 +393,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Cleanup. (tramp-archive-cleanup-hash))) +(tramp-archive--test-deftest-cascaded tramp-archive-test07-file-exists-p) + (ert-deftest tramp-archive-test08-file-local-copy () "Check `file-local-copy'." :tags '(:expensive-test) @@ -382,6 +422,8 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (tramp-archive--test-delete tmp-name)) (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test08-file-local-copy) + (ert-deftest tramp-archive-test09-insert-file-contents () "Check `insert-file-contents'." :tags '(:expensive-test) @@ -409,6 +451,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test09-insert-file-contents) + (ert-deftest tramp-archive-test11-copy-file () "Check `copy-file'." :tags '(:expensive-test) @@ -475,6 +519,8 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (tramp-archive--test-delete tmp-name2)) (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test11-copy-file) + (ert-deftest tramp-archive-test15-copy-directory () "Check `copy-directory'." :tags '(:expensive-test) @@ -528,6 +574,8 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (tramp-archive--test-delete tmp-name2)) (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test15-copy-directory) + (ert-deftest tramp-archive-test16-directory-files () "Check `directory-files'." :tags '(:expensive-test) @@ -552,6 +600,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test16-directory-files) + (ert-deftest tramp-archive-test17-insert-directory () "Check `insert-directory'." :tags '(:expensive-test) @@ -600,6 +650,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test17-insert-directory) + (ert-deftest tramp-archive-test18-file-attributes () "Check `file-attributes'. This tests also `access-file', `file-readable-p' and `file-regular-p'." @@ -661,6 +713,8 @@ This tests also `access-file', `file-readable-p' and `file-regular-p'." ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test18-file-attributes) + (ert-deftest tramp-archive-test19-directory-files-and-attributes () "Check `directory-files-and-attributes'." :tags '(:expensive-test) @@ -686,6 +740,9 @@ This tests also `access-file', `file-readable-p' and `file-regular-p'." ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded + tramp-archive-test19-directory-files-and-attributes) + (ert-deftest tramp-archive-test20-file-modes () "Check `file-modes'. This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." @@ -717,6 +774,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test20-file-modes) + (ert-deftest tramp-archive-test21-file-links () "Check `file-symlink-p' and `file-truename'" :tags '(:expensive-test) @@ -758,6 +817,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test21-file-links) + (ert-deftest tramp-archive-test26-file-name-completion () "Check `file-name-completion' and `file-name-all-completions'." :tags '(:expensive-test) @@ -797,6 +858,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; Cleanup. (tramp-archive-cleanup-hash)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test26-file-name-completion) + (ert-deftest tramp-archive-test40-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless tramp-archive-enabled) @@ -824,6 +887,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) +(tramp-archive--test-deftest-cascaded tramp-archive-test40-make-nearby-temp-file) + (ert-deftest tramp-archive-test43-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless tramp-archive-enabled) @@ -837,6 +902,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) +(tramp-archive--test-deftest-cascaded tramp-archive-test43-file-system-info) + ;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. (ert-deftest tramp-archive-test44-user-group-ids () "Check results of user/group functions. @@ -856,6 +923,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (should (equal uid (with-no-warnings (file-user-uid)))) (should (equal gid (with-no-warnings (file-group-gid))))))) +(tramp-archive--test-deftest-cascaded tramp-archive-test44-user-group-ids) + (ert-deftest tramp-archive-test50-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test)