diff options
| author | Michael Albinus | 2024-07-24 15:27:58 +0200 |
|---|---|---|
| committer | Michael Albinus | 2024-07-24 15:27:58 +0200 |
| commit | d458664e893cd74f46bf9d00559ff5386c3dbf44 (patch) | |
| tree | 3dc18396d4a2f509bdfb85acfca1ed5000d4b1ec /test | |
| parent | c4e8112f983a2add3253e5607f0c29f70e5b4081 (diff) | |
| download | emacs-d458664e893cd74f46bf9d00559ff5386c3dbf44.tar.gz emacs-d458664e893cd74f46bf9d00559ff5386c3dbf44.zip | |
Adapt Tramp tests
* test/lisp/net/tramp-archive-tests.el (ert-resource-directory-format)
(ert-resource-directory-trim-left-regexp)
(ert-resource-directory-trim-right-regexp, ert-resource-directory)
(ert-resource-file): Don't define.
(tramp-archive--test-emacs28-p): Remove.
(top): Remove unneeded skips. Use original objects instead of
their `tramp-compat-' counterparts when possible.
* test/lisp/net/tramp-tests.el (seq): Don't require.
(lock-file-name-transforms, process-file-return-signal-string)
(remote-file-name-inhibit-locks, dired-copy-dereference): Don't declare.
(ert-resource-directory-format)
(ert-resource-directory-trim-left-regexp)
(ert-resource-directory-trim-right-regexp, ert-resource-directory)
(ert-resource-file): Don't define.
(tramp--test-emacs28-p): Remove.
(top): Remove unneeded skips. Use original objects instead of
their `tramp-compat-' counterparts when possible.
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/net/tramp-archive-tests.el | 60 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 345 |
2 files changed, 127 insertions, 278 deletions
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 1ca2fa9b9b3..94bb245ee4a 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el | |||
| @@ -33,50 +33,6 @@ | |||
| 33 | (require 'tramp-archive) | 33 | (require 'tramp-archive) |
| 34 | (defvar tramp-persistency-file-name) | 34 | (defvar tramp-persistency-file-name) |
| 35 | 35 | ||
| 36 | ;; `ert-resource-file' was introduced in Emacs 28.1. | ||
| 37 | (unless (macrop 'ert-resource-file) | ||
| 38 | (eval-and-compile | ||
| 39 | (defvar ert-resource-directory-format "%s-resources/" | ||
| 40 | "Format for `ert-resource-directory'.") | ||
| 41 | (defvar ert-resource-directory-trim-left-regexp "" | ||
| 42 | "Regexp for `string-trim' (left) used by `ert-resource-directory'.") | ||
| 43 | (defvar ert-resource-directory-trim-right-regexp | ||
| 44 | (rx (? "-test" (? "s")) ".el") | ||
| 45 | "Regexp for `string-trim' (right) used by `ert-resource-directory'.") | ||
| 46 | |||
| 47 | (defmacro ert-resource-directory () | ||
| 48 | "Return absolute file name of the resource directory for this file. | ||
| 49 | |||
| 50 | The path to the resource directory is the \"resources\" directory | ||
| 51 | in the same directory as the test file. | ||
| 52 | |||
| 53 | If that directory doesn't exist, use the directory named like the | ||
| 54 | test file but formatted by `ert-resource-directory-format' and trimmed | ||
| 55 | using `string-trim' with arguments | ||
| 56 | `ert-resource-directory-trim-left-regexp' and | ||
| 57 | `ert-resource-directory-trim-right-regexp'. The default values mean | ||
| 58 | that if called from a test file named \"foo-tests.el\", return | ||
| 59 | the absolute file name for \"foo-resources\"." | ||
| 60 | `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) | ||
| 61 | (and load-in-progress load-file-name) | ||
| 62 | buffer-file-name)) | ||
| 63 | (default-directory (file-name-directory testfile))) | ||
| 64 | (file-truename | ||
| 65 | (if (file-accessible-directory-p "resources/") | ||
| 66 | (expand-file-name "resources/") | ||
| 67 | (expand-file-name | ||
| 68 | (format | ||
| 69 | ert-resource-directory-format | ||
| 70 | (string-trim testfile | ||
| 71 | ert-resource-directory-trim-left-regexp | ||
| 72 | ert-resource-directory-trim-right-regexp))))))) | ||
| 73 | |||
| 74 | (defmacro ert-resource-file (file) | ||
| 75 | "Return file name of resource file named FILE. | ||
| 76 | A resource file is in the resource directory as per | ||
| 77 | `ert-resource-directory'." | ||
| 78 | `(expand-file-name ,file (ert-resource-directory))))) | ||
| 79 | |||
| 80 | (defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") | 36 | (defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") |
| 81 | "The test file archive.") | 37 | "The test file archive.") |
| 82 | 38 | ||
| @@ -121,12 +77,6 @@ the origin of the temporary TMPFILE, have no write permissions." | |||
| 121 | (directory-files tmpfile 'full directory-files-no-dot-files-regexp)) | 77 | (directory-files tmpfile 'full directory-files-no-dot-files-regexp)) |
| 122 | (delete-directory tmpfile))) | 78 | (delete-directory tmpfile))) |
| 123 | 79 | ||
| 124 | (defun tramp-archive--test-emacs28-p () | ||
| 125 | "Check for Emacs version >= 28.1. | ||
| 126 | Some semantics has been changed for there, without new functions or | ||
| 127 | variables, so we check the Emacs version directly." | ||
| 128 | (>= emacs-major-version 28)) | ||
| 129 | |||
| 130 | (ert-deftest tramp-archive-test00-availability () | 80 | (ert-deftest tramp-archive-test00-availability () |
| 131 | "Test availability of archive file name functions." | 81 | "Test availability of archive file name functions." |
| 132 | :expected-result (if tramp-archive-enabled :passed :failed) | 82 | :expected-result (if tramp-archive-enabled :passed :failed) |
| @@ -881,7 +831,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 881 | (let ((fsi (file-system-info tramp-archive-test-archive))) | 831 | (let ((fsi (file-system-info tramp-archive-test-archive))) |
| 882 | (skip-unless fsi) | 832 | (skip-unless fsi) |
| 883 | (should (and (consp fsi) | 833 | (should (and (consp fsi) |
| 884 | (tramp-compat-length= fsi 3) | 834 | (length= fsi 3) |
| 885 | (numberp (nth 0 fsi)) | 835 | (numberp (nth 0 fsi)) |
| 886 | ;; FREE and AVAIL are always 0. | 836 | ;; FREE and AVAIL are always 0. |
| 887 | (zerop (nth 1 fsi)) | 837 | (zerop (nth 1 fsi)) |
| @@ -925,13 +875,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 925 | (dolist (default-directory | 875 | (dolist (default-directory |
| 926 | (append | 876 | (append |
| 927 | `(,temporary-file-directory) | 877 | `(,temporary-file-directory) |
| 928 | ;; Starting Emacs in a directory which has | 878 | `(,(file-name-as-directory tramp-archive-test-directory)))) |
| 929 | ;; `tramp-archive-file-name-regexp' syntax is | ||
| 930 | ;; supported only with Emacs > 27.2 (sigh!). | ||
| 931 | ;; (Bug#48476) | ||
| 932 | (and (tramp-archive--test-emacs28-p) | ||
| 933 | `(,(file-name-as-directory | ||
| 934 | tramp-archive-test-directory))))) | ||
| 935 | (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) | 879 | (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) |
| 936 | (should | 880 | (should |
| 937 | (string-match | 881 | (string-match |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e958cd354bc..7673ee88569 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -46,7 +46,6 @@ | |||
| 46 | (require 'dired-aux) | 46 | (require 'dired-aux) |
| 47 | (require 'tramp) | 47 | (require 'tramp) |
| 48 | (require 'ert-x) | 48 | (require 'ert-x) |
| 49 | (require 'seq) ; For `seq-random-elt', autoloaded since Emacs 28.1 | ||
| 50 | (require 'tar-mode) | 49 | (require 'tar-mode) |
| 51 | (require 'trace) | 50 | (require 'trace) |
| 52 | (require 'vc) | 51 | (require 'vc) |
| @@ -75,60 +74,10 @@ | |||
| 75 | (defvar tramp-remote-process-environment) | 74 | (defvar tramp-remote-process-environment) |
| 76 | (defvar tramp-use-connection-share) | 75 | (defvar tramp-use-connection-share) |
| 77 | 76 | ||
| 78 | ;; Needed for Emacs 27. | ||
| 79 | (defvar lock-file-name-transforms) | ||
| 80 | (defvar process-file-return-signal-string) | ||
| 81 | (defvar remote-file-name-inhibit-locks) | ||
| 82 | (defvar dired-copy-dereference) | ||
| 83 | |||
| 84 | ;; Declared in Emacs 30. | 77 | ;; Declared in Emacs 30. |
| 85 | (defvar remote-file-name-access-timeout) | 78 | (defvar remote-file-name-access-timeout) |
| 86 | (defvar remote-file-name-inhibit-delete-by-moving-to-trash) | 79 | (defvar remote-file-name-inhibit-delete-by-moving-to-trash) |
| 87 | 80 | ||
| 88 | ;; `ert-resource-file' was introduced in Emacs 28.1. | ||
| 89 | (unless (macrop 'ert-resource-file) | ||
| 90 | (eval-and-compile | ||
| 91 | (defvar ert-resource-directory-format "%s-resources/" | ||
| 92 | "Format for `ert-resource-directory'.") | ||
| 93 | (defvar ert-resource-directory-trim-left-regexp "" | ||
| 94 | "Regexp for `string-trim' (left) used by `ert-resource-directory'.") | ||
| 95 | (defvar ert-resource-directory-trim-right-regexp | ||
| 96 | (rx (? "-test" (? "s")) ".el") | ||
| 97 | "Regexp for `string-trim' (right) used by `ert-resource-directory'.") | ||
| 98 | |||
| 99 | (defmacro ert-resource-directory () | ||
| 100 | "Return absolute file name of the resource directory for this file. | ||
| 101 | |||
| 102 | The path to the resource directory is the \"resources\" directory | ||
| 103 | in the same directory as the test file. | ||
| 104 | |||
| 105 | If that directory doesn't exist, use the directory named like the | ||
| 106 | test file but formatted by `ert-resource-directory-format' and trimmed | ||
| 107 | using `string-trim' with arguments | ||
| 108 | `ert-resource-directory-trim-left-regexp' and | ||
| 109 | `ert-resource-directory-trim-right-regexp'. The default values mean | ||
| 110 | that if called from a test file named \"foo-tests.el\", return | ||
| 111 | the absolute file name for \"foo-resources\"." | ||
| 112 | `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file) | ||
| 113 | (and load-in-progress load-file-name) | ||
| 114 | buffer-file-name)) | ||
| 115 | (default-directory (file-name-directory testfile))) | ||
| 116 | (file-truename | ||
| 117 | (if (file-accessible-directory-p "resources/") | ||
| 118 | (expand-file-name "resources/") | ||
| 119 | (expand-file-name | ||
| 120 | (format | ||
| 121 | ert-resource-directory-format | ||
| 122 | (string-trim testfile | ||
| 123 | ert-resource-directory-trim-left-regexp | ||
| 124 | ert-resource-directory-trim-right-regexp))))))) | ||
| 125 | |||
| 126 | (defmacro ert-resource-file (file) | ||
| 127 | "Return file name of resource file named FILE. | ||
| 128 | A resource file is in the resource directory as per | ||
| 129 | `ert-resource-directory'." | ||
| 130 | `(expand-file-name ,file (ert-resource-directory))))) | ||
| 131 | |||
| 132 | ;; `ert-remote-temporary-file-directory' was introduced in Emacs 29.1. | 81 | ;; `ert-remote-temporary-file-directory' was introduced in Emacs 29.1. |
| 133 | ;; Adapting `tramp-remote-path' happens also there. | 82 | ;; Adapting `tramp-remote-path' happens also there. |
| 134 | (unless (boundp 'ert-remote-temporary-file-directory) | 83 | (unless (boundp 'ert-remote-temporary-file-directory) |
| @@ -2350,8 +2299,6 @@ is greater than 10. | |||
| 2350 | (skip-unless (tramp--test-enabled)) | 2299 | (skip-unless (tramp--test-enabled)) |
| 2351 | ;; Methods with a share do not expand "/path/..". | 2300 | ;; Methods with a share do not expand "/path/..". |
| 2352 | (skip-unless (not (tramp--test-share-p))) | 2301 | (skip-unless (not (tramp--test-share-p))) |
| 2353 | ;; The bugs are fixed in Emacs 28.1. | ||
| 2354 | (skip-unless (tramp--test-emacs28-p)) | ||
| 2355 | 2302 | ||
| 2356 | (should | 2303 | (should |
| 2357 | (string-equal | 2304 | (string-equal |
| @@ -2646,18 +2593,15 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2646 | (should (string-equal (buffer-string) "foo")) | 2593 | (should (string-equal (buffer-string) "foo")) |
| 2647 | (should (= point (point)))) | 2594 | (should (= point (point)))) |
| 2648 | ;; Insert another string. | 2595 | ;; Insert another string. |
| 2649 | ;; `replace-string-in-region' was introduced in Emacs 28.1. | 2596 | (let ((point (point))) |
| 2650 | (when (tramp--test-emacs28-p) | 2597 | (replace-string-in-region "foo" "bar" (point-min) (point-max)) |
| 2651 | (let ((point (point))) | 2598 | (goto-char point) |
| 2652 | (with-no-warnings | 2599 | (should |
| 2653 | (replace-string-in-region "foo" "bar" (point-min) (point-max))) | 2600 | (equal |
| 2654 | (goto-char point) | 2601 | (insert-file-contents tmp-name nil nil nil 'replace) |
| 2655 | (should | 2602 | `(,(expand-file-name tmp-name) 3))) |
| 2656 | (equal | 2603 | (should (string-equal (buffer-string) "foo")) |
| 2657 | (insert-file-contents tmp-name nil nil nil 'replace) | 2604 | (should (= point (point)))) |
| 2658 | `(,(expand-file-name tmp-name) 3))) | ||
| 2659 | (should (string-equal (buffer-string) "foo")) | ||
| 2660 | (should (= point (point))))) | ||
| 2661 | ;; Error case. | 2605 | ;; Error case. |
| 2662 | (delete-file tmp-name) | 2606 | (delete-file tmp-name) |
| 2663 | (should-error | 2607 | (should-error |
| @@ -2762,9 +2706,9 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2762 | ;; `tramp-test39-make-lock-file-name'. | 2706 | ;; `tramp-test39-make-lock-file-name'. |
| 2763 | 2707 | ||
| 2764 | ;; Do not overwrite if excluded. | 2708 | ;; Do not overwrite if excluded. |
| 2765 | (cl-letf (((symbol-function #'y-or-n-p) #'tramp-compat-always) | 2709 | (cl-letf (((symbol-function #'y-or-n-p) #'always) |
| 2766 | ;; Ange-FTP. | 2710 | ;; Ange-FTP. |
| 2767 | ((symbol-function #'yes-or-no-p) #'tramp-compat-always)) | 2711 | ((symbol-function #'yes-or-no-p) #'always)) |
| 2768 | (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) | 2712 | (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) |
| 2769 | (should-error | 2713 | (should-error |
| 2770 | (cl-letf (((symbol-function #'y-or-n-p) #'ignore) | 2714 | (cl-letf (((symbol-function #'y-or-n-p) #'ignore) |
| @@ -2831,8 +2775,6 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2831 | (skip-unless (tramp--test-enabled)) | 2775 | (skip-unless (tramp--test-enabled)) |
| 2832 | (skip-unless (not (tramp--test-ange-ftp-p))) | 2776 | (skip-unless (not (tramp--test-ange-ftp-p))) |
| 2833 | (skip-unless (executable-find "gzip")) | 2777 | (skip-unless (executable-find "gzip")) |
| 2834 | ;; The function was introduced in Emacs 28.1. | ||
| 2835 | (skip-unless (boundp 'tar-goto-file)) | ||
| 2836 | 2778 | ||
| 2837 | (let* ((default-directory ert-remote-temporary-file-directory) | 2779 | (let* ((default-directory ert-remote-temporary-file-directory) |
| 2838 | (archive (ert-resource-file "foo.tar.gz")) | 2780 | (archive (ert-resource-file "foo.tar.gz")) |
| @@ -2846,8 +2788,7 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2846 | (copy-file archive tmp-file 'ok) | 2788 | (copy-file archive tmp-file 'ok) |
| 2847 | ;; Read archive. Check contents of foo.txt, and modify it. Save. | 2789 | ;; Read archive. Check contents of foo.txt, and modify it. Save. |
| 2848 | (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) | 2790 | (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) |
| 2849 | ;; The function was introduced in Emacs 28.1. | 2791 | (should (tar-goto-file "foo.txt")) |
| 2850 | (with-no-warnings (should (tar-goto-file "foo.txt"))) | ||
| 2851 | (save-current-buffer | 2792 | (save-current-buffer |
| 2852 | (setq buffer2 (tar-extract)) | 2793 | (setq buffer2 (tar-extract)) |
| 2853 | (should (string-equal (buffer-string) "foo\n")) | 2794 | (should (string-equal (buffer-string) "foo\n")) |
| @@ -2864,8 +2805,7 @@ This checks also `file-name-as-directory', `file-name-directory', | |||
| 2864 | (kill-buffer buffer2) | 2805 | (kill-buffer buffer2) |
| 2865 | ;; Read archive. Check contents of modified foo.txt. | 2806 | ;; Read archive. Check contents of modified foo.txt. |
| 2866 | (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) | 2807 | (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) |
| 2867 | ;; The function was introduced in Emacs 28.1. | 2808 | (should (tar-goto-file "foo.txt")) |
| 2868 | (with-no-warnings (should (tar-goto-file "foo.txt"))) | ||
| 2869 | (save-current-buffer | 2809 | (save-current-buffer |
| 2870 | (setq buffer2 (tar-extract)) | 2810 | (setq buffer2 (tar-extract)) |
| 2871 | (should (string-equal (buffer-string) "foo\nbar\n"))))) | 2811 | (should (string-equal (buffer-string) "foo\nbar\n"))))) |
| @@ -3304,46 +3244,45 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 3304 | (delete-directory tmp-name1 'recursive) | 3244 | (delete-directory tmp-name1 'recursive) |
| 3305 | (delete-directory tmp-name2 'recursive))) | 3245 | (delete-directory tmp-name2 'recursive))) |
| 3306 | 3246 | ||
| 3307 | ;; Copy symlink to directory. Implemented since Emacs 28.1. | 3247 | ;; Copy symlink to directory. |
| 3308 | (when (boundp 'copy-directory-create-symlink) | 3248 | (dolist (copy-directory-create-symlink '(nil t)) |
| 3309 | (dolist (copy-directory-create-symlink '(nil t)) | 3249 | (unwind-protect |
| 3310 | (unwind-protect | 3250 | (tramp--test-ignore-make-symbolic-link-error |
| 3311 | (tramp--test-ignore-make-symbolic-link-error | 3251 | ;; Copy to file name. |
| 3312 | ;; Copy to file name. | 3252 | (make-directory tmp-name1) |
| 3313 | (make-directory tmp-name1) | 3253 | (write-region "foo" nil tmp-name4) |
| 3314 | (write-region "foo" nil tmp-name4) | 3254 | (make-symbolic-link tmp-name1 tmp-name7) |
| 3315 | (make-symbolic-link tmp-name1 tmp-name7) | 3255 | (should (file-directory-p tmp-name1)) |
| 3316 | (should (file-directory-p tmp-name1)) | 3256 | (should (file-exists-p tmp-name4)) |
| 3317 | (should (file-exists-p tmp-name4)) | 3257 | (should (file-symlink-p tmp-name7)) |
| 3318 | (should (file-symlink-p tmp-name7)) | 3258 | (copy-directory tmp-name7 tmp-name2) |
| 3319 | (copy-directory tmp-name7 tmp-name2) | 3259 | (if copy-directory-create-symlink |
| 3320 | (if copy-directory-create-symlink | 3260 | (should |
| 3321 | (should | 3261 | (string-equal |
| 3322 | (string-equal | 3262 | (file-symlink-p tmp-name2) (file-symlink-p tmp-name7))) |
| 3323 | (file-symlink-p tmp-name2) (file-symlink-p tmp-name7))) | 3263 | (should (file-directory-p tmp-name2))) |
| 3324 | (should (file-directory-p tmp-name2))) | 3264 | ;; Copy to directory name. |
| 3325 | ;; Copy to directory name. | 3265 | (delete-directory tmp-name2 'recursive) |
| 3326 | (delete-directory tmp-name2 'recursive) | 3266 | (make-directory tmp-name2) |
| 3327 | (make-directory tmp-name2) | 3267 | (should (file-directory-p tmp-name2)) |
| 3328 | (should (file-directory-p tmp-name2)) | 3268 | (copy-directory tmp-name7 (file-name-as-directory tmp-name2)) |
| 3329 | (copy-directory tmp-name7 (file-name-as-directory tmp-name2)) | 3269 | (if copy-directory-create-symlink |
| 3330 | (if copy-directory-create-symlink | 3270 | (should |
| 3331 | (should | 3271 | (string-equal |
| 3332 | (string-equal | 3272 | (file-symlink-p |
| 3333 | (file-symlink-p | ||
| 3334 | (expand-file-name | ||
| 3335 | (file-name-nondirectory tmp-name7) tmp-name2)) | ||
| 3336 | (file-symlink-p tmp-name7))) | ||
| 3337 | (should | ||
| 3338 | (file-directory-p | ||
| 3339 | (expand-file-name | 3273 | (expand-file-name |
| 3340 | (file-name-nondirectory tmp-name7) tmp-name2))))) | 3274 | (file-name-nondirectory tmp-name7) tmp-name2)) |
| 3275 | (file-symlink-p tmp-name7))) | ||
| 3276 | (should | ||
| 3277 | (file-directory-p | ||
| 3278 | (expand-file-name | ||
| 3279 | (file-name-nondirectory tmp-name7) tmp-name2))))) | ||
| 3341 | 3280 | ||
| 3342 | ;; Cleanup. | 3281 | ;; Cleanup. |
| 3343 | (ignore-errors | 3282 | (ignore-errors |
| 3344 | (delete-directory tmp-name1 'recursive) | 3283 | (delete-directory tmp-name1 'recursive) |
| 3345 | (delete-directory tmp-name2 'recursive) | 3284 | (delete-directory tmp-name2 'recursive) |
| 3346 | (delete-directory tmp-name7 'recursive)))))))) | 3285 | (delete-directory tmp-name7 'recursive))))))) |
| 3347 | 3286 | ||
| 3348 | (ert-deftest tramp-test16-directory-files () | 3287 | (ert-deftest tramp-test16-directory-files () |
| 3349 | "Check `directory-files'." | 3288 | "Check `directory-files'." |
| @@ -3376,14 +3315,12 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 3376 | (should (equal (directory-files | 3315 | (should (equal (directory-files |
| 3377 | tmp-name1 'full directory-files-no-dot-files-regexp) | 3316 | tmp-name1 'full directory-files-no-dot-files-regexp) |
| 3378 | `(,tmp-name2 ,tmp-name3))) | 3317 | `(,tmp-name2 ,tmp-name3))) |
| 3379 | ;; Check the COUNT arg. It exists since Emacs 28. | 3318 | ;; Check the COUNT arg. |
| 3380 | (when (tramp--test-emacs28-p) | 3319 | (should |
| 3381 | (with-no-warnings | 3320 | (equal |
| 3382 | (should | 3321 | (directory-files |
| 3383 | (equal | 3322 | tmp-name1 nil directory-files-no-dot-files-regexp nil 1) |
| 3384 | (directory-files | 3323 | '("bla")))) |
| 3385 | tmp-name1 nil directory-files-no-dot-files-regexp nil 1) | ||
| 3386 | '("bla")))))) | ||
| 3387 | 3324 | ||
| 3388 | ;; Cleanup. | 3325 | ;; Cleanup. |
| 3389 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) | 3326 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) |
| @@ -4096,12 +4033,10 @@ They might differ only in time attributes or directory size." | |||
| 4096 | tmp-name2 nil (rx bos "b"))) | 4033 | tmp-name2 nil (rx bos "b"))) |
| 4097 | (should (equal (mapcar #'car attr) '("bar" "boz"))) | 4034 | (should (equal (mapcar #'car attr) '("bar" "boz"))) |
| 4098 | 4035 | ||
| 4099 | ;; Check the COUNT arg. It exists since Emacs 28. | 4036 | ;; Check the COUNT arg. |
| 4100 | (when (tramp--test-emacs28-p) | 4037 | (setq attr (directory-files-and-attributes |
| 4101 | (with-no-warnings | 4038 | tmp-name2 nil (rx bos "b") nil nil 1)) |
| 4102 | (setq attr (directory-files-and-attributes | 4039 | (should (equal (mapcar #'car attr) '("bar")))) |
| 4103 | tmp-name2 nil (rx bos "b") nil nil 1)) | ||
| 4104 | (should (equal (mapcar #'car attr) '("bar")))))) | ||
| 4105 | 4040 | ||
| 4106 | ;; Cleanup. | 4041 | ;; Cleanup. |
| 4107 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) | 4042 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) |
| @@ -4141,12 +4076,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 4141 | (or (zerop (file-attribute-user-id (file-attributes tmp-name1))) | 4076 | (or (zerop (file-attribute-user-id (file-attributes tmp-name1))) |
| 4142 | (tramp--test-sshfs-p)) | 4077 | (tramp--test-sshfs-p)) |
| 4143 | (should-not (file-writable-p tmp-name1))) | 4078 | (should-not (file-writable-p tmp-name1))) |
| 4144 | ;; Check the NOFOLLOW arg. It exists since Emacs 28. For | 4079 | ;; Check the NOFOLLOW arg. For regular files, there |
| 4145 | ;; regular files, there shouldn't be a difference. | 4080 | ;; shouldn't be a difference. |
| 4146 | (when (tramp--test-emacs28-p) | 4081 | (set-file-modes tmp-name1 #o222 'nofollow) |
| 4147 | (with-no-warnings | 4082 | (should (= (file-modes tmp-name1 'nofollow) #o222)) |
| 4148 | (set-file-modes tmp-name1 #o222 'nofollow) | ||
| 4149 | (should (= (file-modes tmp-name1 'nofollow) #o222)))) | ||
| 4150 | ;; Setting the mode for not existing files shall fail. | 4083 | ;; Setting the mode for not existing files shall fail. |
| 4151 | (should-error | 4084 | (should-error |
| 4152 | (set-file-modes tmp-name2 #o777) | 4085 | (set-file-modes tmp-name2 #o777) |
| @@ -4155,15 +4088,13 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 4155 | ;; Cleanup. | 4088 | ;; Cleanup. |
| 4156 | (ignore-errors (delete-file tmp-name1))) | 4089 | (ignore-errors (delete-file tmp-name1))) |
| 4157 | 4090 | ||
| 4158 | ;; Check the NOFOLLOW arg. It exists since Emacs 28. It is | 4091 | ;; Check the NOFOLLOW arg. It is implemented for tramp-gvfs.el |
| 4159 | ;; implemented for tramp-gvfs.el and tramp-sh.el. However, | 4092 | ;; and tramp-sh.el. However, tramp-gvfs,el does not support |
| 4160 | ;; tramp-gvfs,el does not support creating symbolic links. And | 4093 | ;; creating symbolic links. And in tramp-sh.el, we must ensure |
| 4161 | ;; in tramp-sh.el, we must ensure that the remote chmod command | 4094 | ;; that the remote chmod command supports the "-h" argument. |
| 4162 | ;; supports the "-h" argument. | 4095 | (when (and (tramp--test-sh-p) (tramp-get-remote-chmod-h tramp-test-vec)) |
| 4163 | (when (and (tramp--test-emacs28-p) (tramp--test-sh-p) | ||
| 4164 | (tramp-get-remote-chmod-h tramp-test-vec)) | ||
| 4165 | (unwind-protect | 4096 | (unwind-protect |
| 4166 | (with-no-warnings | 4097 | (progn |
| 4167 | (write-region "foo" nil tmp-name1) | 4098 | (write-region "foo" nil tmp-name1) |
| 4168 | (should (file-exists-p tmp-name1)) | 4099 | (should (file-exists-p tmp-name1)) |
| 4169 | (make-symbolic-link tmp-name1 tmp-name2) | 4100 | (make-symbolic-link tmp-name1 tmp-name2) |
| @@ -4256,7 +4187,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4256 | (should-error | 4187 | (should-error |
| 4257 | (make-symbolic-link tmp-name1 tmp-name2 0) | 4188 | (make-symbolic-link tmp-name1 tmp-name2 0) |
| 4258 | :type 'file-already-exists))) | 4189 | :type 'file-already-exists))) |
| 4259 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) | 4190 | (cl-letf (((symbol-function #'yes-or-no-p) #'always)) |
| 4260 | (make-symbolic-link tmp-name1 tmp-name2 0) | 4191 | (make-symbolic-link tmp-name1 tmp-name2 0) |
| 4261 | (should | 4192 | (should |
| 4262 | (string-equal | 4193 | (string-equal |
| @@ -4336,7 +4267,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4336 | (should-error | 4267 | (should-error |
| 4337 | (add-name-to-file tmp-name1 tmp-name2 0) | 4268 | (add-name-to-file tmp-name1 tmp-name2 0) |
| 4338 | :type 'file-already-exists)) | 4269 | :type 'file-already-exists)) |
| 4339 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) | 4270 | (cl-letf (((symbol-function #'yes-or-no-p) #'always)) |
| 4340 | (add-name-to-file tmp-name1 tmp-name2 0) | 4271 | (add-name-to-file tmp-name1 tmp-name2 0) |
| 4341 | (should (file-regular-p tmp-name2))) | 4272 | (should (file-regular-p tmp-name2))) |
| 4342 | (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) | 4273 | (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) |
| @@ -4548,16 +4479,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4548 | ;; `tmp-name3' does not exist. | 4479 | ;; `tmp-name3' does not exist. |
| 4549 | (should (file-newer-than-file-p tmp-name2 tmp-name3)) | 4480 | (should (file-newer-than-file-p tmp-name2 tmp-name3)) |
| 4550 | (should-not (file-newer-than-file-p tmp-name3 tmp-name1)) | 4481 | (should-not (file-newer-than-file-p tmp-name3 tmp-name1)) |
| 4551 | ;; Check the NOFOLLOW arg. It exists since Emacs 28. For | 4482 | ;; Check the NOFOLLOW arg. For regular files, there |
| 4552 | ;; regular files, there shouldn't be a difference. | 4483 | ;; shouldn't be a difference. |
| 4553 | (when (tramp--test-emacs28-p) | 4484 | (set-file-times tmp-name1 (seconds-to-time 60) 'nofollow) |
| 4554 | (with-no-warnings | 4485 | (should |
| 4555 | (set-file-times tmp-name1 (seconds-to-time 60) 'nofollow) | 4486 | (time-equal-p |
| 4556 | (should | 4487 | (file-attribute-modification-time (file-attributes tmp-name1)) |
| 4557 | (time-equal-p | 4488 | (seconds-to-time 60))))) |
| 4558 | (file-attribute-modification-time | ||
| 4559 | (file-attributes tmp-name1)) | ||
| 4560 | (seconds-to-time 60))))))) | ||
| 4561 | 4489 | ||
| 4562 | ;; Cleanup. | 4490 | ;; Cleanup. |
| 4563 | (ignore-errors | 4491 | (ignore-errors |
| @@ -4890,8 +4818,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4890 | ;; Ange-FTP does not support this. | 4818 | ;; Ange-FTP does not support this. |
| 4891 | (unless (tramp--test-ange-ftp-p) | 4819 | (unless (tramp--test-ange-ftp-p) |
| 4892 | (should-not | 4820 | (should-not |
| 4893 | (file-name-completion | 4821 | (file-name-completion "a" (file-name-concat tmp-name "fuzz")))) |
| 4894 | "a" (tramp-compat-file-name-concat tmp-name "fuzz")))) | ||
| 4895 | ;; Ange-FTP does not support predicates. | 4822 | ;; Ange-FTP does not support predicates. |
| 4896 | (unless (tramp--test-ange-ftp-p) | 4823 | (unless (tramp--test-ange-ftp-p) |
| 4897 | (should | 4824 | (should |
| @@ -5219,7 +5146,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 5219 | (goto-char (point-min)) | 5146 | (goto-char (point-min)) |
| 5220 | (while (search-forward-regexp | 5147 | (while (search-forward-regexp |
| 5221 | ansi-color-control-seq-regexp nil t) | 5148 | ansi-color-control-seq-regexp nil t) |
| 5222 | (replace-match "" nil nil)) | 5149 | (replace-match "")) |
| 5223 | (should | 5150 | (should |
| 5224 | (string-equal (if destination (format "%s\n" fnnd) "") | 5151 | (string-equal (if destination (format "%s\n" fnnd) "") |
| 5225 | (buffer-string))) | 5152 | (buffer-string))) |
| @@ -5234,7 +5161,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 5234 | (goto-char (point-min)) | 5161 | (goto-char (point-min)) |
| 5235 | (while (search-forward-regexp | 5162 | (while (search-forward-regexp |
| 5236 | ansi-color-control-seq-regexp nil t) | 5163 | ansi-color-control-seq-regexp nil t) |
| 5237 | (replace-match "" nil nil)) | 5164 | (replace-match "")) |
| 5238 | (should | 5165 | (should |
| 5239 | (string-equal | 5166 | (string-equal |
| 5240 | (if destination (format "%s\n%s\n" fnnd fnnd) "") | 5167 | (if destination (format "%s\n%s\n" fnnd fnnd) "") |
| @@ -5480,7 +5407,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 5480 | ;; We do expect an established connection already, | 5407 | ;; We do expect an established connection already, |
| 5481 | ;; `file-truename' does it by side-effect. Suppress | 5408 | ;; `file-truename' does it by side-effect. Suppress |
| 5482 | ;; `tramp--test-enabled', in order to keep the connection. | 5409 | ;; `tramp--test-enabled', in order to keep the connection. |
| 5483 | (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always)) | 5410 | (cl-letf (((symbol-function #'tramp--test-enabled) #'always)) |
| 5484 | (file-truename ert-remote-temporary-file-directory) | 5411 | (file-truename ert-remote-temporary-file-directory) |
| 5485 | (funcall (ert-test-body ert-test)))))) | 5412 | (funcall (ert-test-body ert-test)))))) |
| 5486 | 5413 | ||
| @@ -5906,7 +5833,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 5906 | (when-let ((default-directory ert-remote-temporary-file-directory) | 5833 | (when-let ((default-directory ert-remote-temporary-file-directory) |
| 5907 | (mi (memory-info))) | 5834 | (mi (memory-info))) |
| 5908 | (should (consp mi)) | 5835 | (should (consp mi)) |
| 5909 | (should (tramp-compat-length= mi 4)) | 5836 | (should (length= mi 4)) |
| 5910 | (dotimes (i (length mi)) | 5837 | (dotimes (i (length mi)) |
| 5911 | (should (natnump (nth i mi)))))) | 5838 | (should (natnump (nth i mi)))))) |
| 5912 | 5839 | ||
| @@ -5967,7 +5894,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 5967 | ;; "ls" could produce colorized output. | 5894 | ;; "ls" could produce colorized output. |
| 5968 | (goto-char (point-min)) | 5895 | (goto-char (point-min)) |
| 5969 | (while (search-forward-regexp ansi-color-control-seq-regexp nil t) | 5896 | (while (search-forward-regexp ansi-color-control-seq-regexp nil t) |
| 5970 | (replace-match "" nil nil)) | 5897 | (replace-match "")) |
| 5971 | (should | 5898 | (should |
| 5972 | (string-equal | 5899 | (string-equal |
| 5973 | (format "%s\n" (file-name-nondirectory tmp-name)) | 5900 | (format "%s\n" (file-name-nondirectory tmp-name)) |
| @@ -6303,8 +6230,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6303 | ;; `local-variable' is buffer-local due to explicit setting. | 6230 | ;; `local-variable' is buffer-local due to explicit setting. |
| 6304 | ;; We need `with-no-warnings', because `defvar-local' is not | 6231 | ;; We need `with-no-warnings', because `defvar-local' is not |
| 6305 | ;; called at toplevel. | 6232 | ;; called at toplevel. |
| 6306 | (with-no-warnings | 6233 | (with-no-warnings (defvar-local local-variable 'buffer)) |
| 6307 | (defvar-local local-variable 'buffer)) | ||
| 6308 | (with-temp-buffer | 6234 | (with-temp-buffer |
| 6309 | (should (eq local-variable 'buffer))) | 6235 | (should (eq local-variable 'buffer))) |
| 6310 | 6236 | ||
| @@ -6486,7 +6412,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6486 | (unless (tramp--test-container-oob-p) | 6412 | (unless (tramp--test-container-oob-p) |
| 6487 | (make-directory tmp-name) | 6413 | (make-directory tmp-name) |
| 6488 | (should (file-directory-p tmp-name)) | 6414 | (should (file-directory-p tmp-name)) |
| 6489 | (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) | 6415 | (while (length< (string-join orig-exec-path ":") 5000) |
| 6490 | (let ((dir (make-temp-file | 6416 | (let ((dir (make-temp-file |
| 6491 | (file-name-as-directory tmp-name) 'dir))) | 6417 | (file-name-as-directory tmp-name) 'dir))) |
| 6492 | (should (file-directory-p dir)) | 6418 | (should (file-directory-p dir)) |
| @@ -6503,7 +6429,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6503 | ;; Ignore trailing newline. | 6429 | ;; Ignore trailing newline. |
| 6504 | (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) | 6430 | (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) |
| 6505 | ;; The shell doesn't handle such long strings. | 6431 | ;; The shell doesn't handle such long strings. |
| 6506 | (unless (tramp-compat-length> | 6432 | (unless (length> |
| 6507 | path | 6433 | path |
| 6508 | (tramp-get-connection-property | 6434 | (tramp-get-connection-property |
| 6509 | tramp-test-vec "pipe-buf" 4096)) | 6435 | tramp-test-vec "pipe-buf" 4096)) |
| @@ -6707,8 +6633,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6707 | :type 'file-error)) | 6633 | :type 'file-error)) |
| 6708 | (tramp-cleanup-connection | 6634 | (tramp-cleanup-connection |
| 6709 | tramp-test-vec 'keep-debug 'keep-password) | 6635 | tramp-test-vec 'keep-debug 'keep-password) |
| 6710 | (cl-letf (((symbol-function #'yes-or-no-p) | 6636 | (cl-letf (((symbol-function #'yes-or-no-p) #'always)) |
| 6711 | #'tramp-compat-always)) | ||
| 6712 | (should (stringp (make-auto-save-file-name)))))))) | 6637 | (should (stringp (make-auto-save-file-name)))))))) |
| 6713 | 6638 | ||
| 6714 | ;; Cleanup. | 6639 | ;; Cleanup. |
| @@ -6854,25 +6779,18 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6854 | :type 'file-error)) | 6779 | :type 'file-error)) |
| 6855 | (tramp-cleanup-connection | 6780 | (tramp-cleanup-connection |
| 6856 | tramp-test-vec 'keep-debug 'keep-password) | 6781 | tramp-test-vec 'keep-debug 'keep-password) |
| 6857 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) | 6782 | (cl-letf (((symbol-function #'yes-or-no-p) #'always)) |
| 6858 | (should (stringp (car (find-backup-file-name tmp-name1))))))) | 6783 | (should (stringp (car (find-backup-file-name tmp-name1))))))) |
| 6859 | 6784 | ||
| 6860 | ;; Cleanup. | 6785 | ;; Cleanup. |
| 6861 | (ignore-errors (delete-file tmp-name1)) | 6786 | (ignore-errors (delete-file tmp-name1)) |
| 6862 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) | 6787 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) |
| 6863 | 6788 | ||
| 6864 | ;; The functions were introduced in Emacs 28.1. | ||
| 6865 | (ert-deftest tramp-test39-make-lock-file-name () | 6789 | (ert-deftest tramp-test39-make-lock-file-name () |
| 6866 | "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'." | 6790 | "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'." |
| 6867 | (skip-unless (tramp--test-enabled)) | 6791 | (skip-unless (tramp--test-enabled)) |
| 6868 | (skip-unless (not (tramp--test-ange-ftp-p))) | 6792 | (skip-unless (not (tramp--test-ange-ftp-p))) |
| 6869 | ;; Since Emacs 28.1. | ||
| 6870 | (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) | ||
| 6871 | (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name))) | ||
| 6872 | 6793 | ||
| 6873 | ;; `lock-file', `unlock-file', `file-locked-p' and | ||
| 6874 | ;; `make-lock-file-name' exist since Emacs 28.1. We don't want to | ||
| 6875 | ;; see compiler warnings for older Emacsen. | ||
| 6876 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) | 6794 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) |
| 6877 | (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) | 6795 | (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) |
| 6878 | (tmp-name2 (tramp--test-make-temp-name nil quoted)) | 6796 | (tmp-name2 (tramp--test-make-temp-name nil quoted)) |
| @@ -6889,13 +6807,13 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6889 | (unwind-protect | 6807 | (unwind-protect |
| 6890 | (progn | 6808 | (progn |
| 6891 | ;; A simple file lock. | 6809 | ;; A simple file lock. |
| 6892 | (should-not (with-no-warnings (file-locked-p tmp-name1))) | 6810 | (should-not (file-locked-p tmp-name1)) |
| 6893 | (with-no-warnings (lock-file tmp-name1)) | 6811 | (lock-file tmp-name1) |
| 6894 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6812 | (should (eq (file-locked-p tmp-name1) t)) |
| 6895 | 6813 | ||
| 6896 | ;; If it is locked already, nothing changes. | 6814 | ;; If it is locked already, nothing changes. |
| 6897 | (with-no-warnings (lock-file tmp-name1)) | 6815 | (lock-file tmp-name1) |
| 6898 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6816 | (should (eq (file-locked-p tmp-name1) t)) |
| 6899 | 6817 | ||
| 6900 | ;; `save-buffer' removes the lock. | 6818 | ;; `save-buffer' removes the lock. |
| 6901 | (with-temp-buffer | 6819 | (with-temp-buffer |
| @@ -6904,11 +6822,11 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6904 | (should (buffer-modified-p)) | 6822 | (should (buffer-modified-p)) |
| 6905 | (save-buffer) | 6823 | (save-buffer) |
| 6906 | (should-not (buffer-modified-p))) | 6824 | (should-not (buffer-modified-p))) |
| 6907 | (should-not (with-no-warnings (file-locked-p tmp-name1))) | 6825 | (should-not (file-locked-p tmp-name1)) |
| 6908 | 6826 | ||
| 6909 | ;; `kill-buffer' removes the lock. | 6827 | ;; `kill-buffer' removes the lock. |
| 6910 | (with-no-warnings (lock-file tmp-name1)) | 6828 | (lock-file tmp-name1) |
| 6911 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6829 | (should (eq (file-locked-p tmp-name1) t)) |
| 6912 | (with-temp-buffer | 6830 | (with-temp-buffer |
| 6913 | (set-visited-file-name tmp-name1) | 6831 | (set-visited-file-name tmp-name1) |
| 6914 | (insert "foo") | 6832 | (insert "foo") |
| @@ -6916,12 +6834,12 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6916 | (cl-letf (((symbol-function #'read-from-minibuffer) | 6834 | (cl-letf (((symbol-function #'read-from-minibuffer) |
| 6917 | (lambda (&rest _args) "yes"))) | 6835 | (lambda (&rest _args) "yes"))) |
| 6918 | (kill-buffer))) | 6836 | (kill-buffer))) |
| 6919 | (should-not (with-no-warnings (file-locked-p tmp-name1))) | 6837 | (should-not (file-locked-p tmp-name1)) |
| 6920 | 6838 | ||
| 6921 | ;; `kill-buffer' should not remove the lock when the | 6839 | ;; `kill-buffer' should not remove the lock when the |
| 6922 | ;; connection is broken. See Bug#61663. | 6840 | ;; connection is broken. See Bug#61663. |
| 6923 | (with-no-warnings (lock-file tmp-name1)) | 6841 | (lock-file tmp-name1) |
| 6924 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6842 | (should (eq (file-locked-p tmp-name1) t)) |
| 6925 | (with-temp-buffer | 6843 | (with-temp-buffer |
| 6926 | (set-visited-file-name tmp-name1) | 6844 | (set-visited-file-name tmp-name1) |
| 6927 | (insert "foo") | 6845 | (insert "foo") |
| @@ -6934,13 +6852,13 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6934 | ;; A new connection changes process id, and also the | 6852 | ;; A new connection changes process id, and also the |
| 6935 | ;; lock file contents. But it still exists. | 6853 | ;; lock file contents. But it still exists. |
| 6936 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6854 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6937 | (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) | 6855 | (should (stringp (file-locked-p tmp-name1))) |
| 6938 | 6856 | ||
| 6939 | ;; When `remote-file-name-inhibit-locks' is set, nothing happens. | 6857 | ;; When `remote-file-name-inhibit-locks' is set, nothing happens. |
| 6940 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6858 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6941 | (let ((remote-file-name-inhibit-locks t)) | 6859 | (let ((remote-file-name-inhibit-locks t)) |
| 6942 | (with-no-warnings (lock-file tmp-name1)) | 6860 | (lock-file tmp-name1) |
| 6943 | (should-not (with-no-warnings (file-locked-p tmp-name1)))) | 6861 | (should-not (file-locked-p tmp-name1))) |
| 6944 | 6862 | ||
| 6945 | ;; When `lock-file-name-transforms' is set, another lock | 6863 | ;; When `lock-file-name-transforms' is set, another lock |
| 6946 | ;; file is used. | 6864 | ;; file is used. |
| @@ -6948,32 +6866,31 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6948 | (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2)))) | 6866 | (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2)))) |
| 6949 | (should | 6867 | (should |
| 6950 | (string-equal | 6868 | (string-equal |
| 6951 | (with-no-warnings (make-lock-file-name tmp-name1)) | 6869 | (make-lock-file-name tmp-name1) |
| 6952 | (with-no-warnings (make-lock-file-name tmp-name2)))) | 6870 | (make-lock-file-name tmp-name2))) |
| 6953 | (with-no-warnings (lock-file tmp-name1)) | 6871 | (lock-file tmp-name1) |
| 6954 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6872 | (should (eq (file-locked-p tmp-name1) t)) |
| 6955 | (with-no-warnings (unlock-file tmp-name1)) | 6873 | (unlock-file tmp-name1) |
| 6956 | (should-not (with-no-warnings (file-locked-p tmp-name1)))) | 6874 | (should-not (file-locked-p tmp-name1))) |
| 6957 | 6875 | ||
| 6958 | ;; Steal the file lock. | 6876 | ;; Steal the file lock. |
| 6959 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6877 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6960 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) | 6878 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) |
| 6961 | (with-no-warnings (lock-file tmp-name1))) | 6879 | (lock-file tmp-name1)) |
| 6962 | (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) | 6880 | (should (eq (file-locked-p tmp-name1) t)) |
| 6963 | 6881 | ||
| 6964 | ;; Ignore the file lock. | 6882 | ;; Ignore the file lock. |
| 6965 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6883 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6966 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) | 6884 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) |
| 6967 | (with-no-warnings (lock-file tmp-name1))) | 6885 | (lock-file tmp-name1)) |
| 6968 | (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) | 6886 | (should (stringp (file-locked-p tmp-name1))) |
| 6969 | 6887 | ||
| 6970 | ;; Quit the file lock machinery. | 6888 | ;; Quit the file lock machinery. |
| 6971 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) | 6889 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) |
| 6972 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) | 6890 | (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) |
| 6973 | (with-no-warnings | 6891 | (should-error |
| 6974 | (should-error | 6892 | (lock-file tmp-name1) |
| 6975 | (lock-file tmp-name1) | 6893 | :type 'file-locked) |
| 6976 | :type 'file-locked)) | ||
| 6977 | ;; The same for `write-region'. | 6894 | ;; The same for `write-region'. |
| 6978 | (should-error | 6895 | (should-error |
| 6979 | (write-region "foo" nil tmp-name1) | 6896 | (write-region "foo" nil tmp-name1) |
| @@ -6986,14 +6903,14 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6986 | (should-error | 6903 | (should-error |
| 6987 | (set-visited-file-name tmp-name1) | 6904 | (set-visited-file-name tmp-name1) |
| 6988 | :type 'file-locked))) | 6905 | :type 'file-locked))) |
| 6989 | (should (stringp (with-no-warnings (file-locked-p tmp-name1))))) | 6906 | (should (stringp (file-locked-p tmp-name1)))) |
| 6990 | 6907 | ||
| 6991 | ;; Cleanup. | 6908 | ;; Cleanup. |
| 6992 | (ignore-errors (delete-file tmp-name1)) | 6909 | (ignore-errors (delete-file tmp-name1)) |
| 6993 | (with-no-warnings (unlock-file tmp-name1)) | 6910 | (unlock-file tmp-name1) |
| 6994 | (with-no-warnings (unlock-file tmp-name2)) | 6911 | (unlock-file tmp-name2) |
| 6995 | (should-not (with-no-warnings (file-locked-p tmp-name1))) | 6912 | (should-not (file-locked-p tmp-name1)) |
| 6996 | (should-not (with-no-warnings (file-locked-p tmp-name2)))) | 6913 | (should-not (file-locked-p tmp-name2))) |
| 6997 | 6914 | ||
| 6998 | (unwind-protect | 6915 | (unwind-protect |
| 6999 | ;; Create temporary file. This shall check for sensible | 6916 | ;; Create temporary file. This shall check for sensible |
| @@ -7010,20 +6927,17 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 7010 | :type 'file-error)) | 6927 | :type 'file-error)) |
| 7011 | (tramp-cleanup-connection | 6928 | (tramp-cleanup-connection |
| 7012 | tramp-test-vec 'keep-debug 'keep-password) | 6929 | tramp-test-vec 'keep-debug 'keep-password) |
| 7013 | (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always)) | 6930 | (cl-letf (((symbol-function #'yes-or-no-p) #'always)) |
| 7014 | (write-region "foo" nil tmp-name1)))) | 6931 | (write-region "foo" nil tmp-name1)))) |
| 7015 | 6932 | ||
| 7016 | ;; Cleanup. | 6933 | ;; Cleanup. |
| 7017 | (ignore-errors (delete-file tmp-name1)) | 6934 | (ignore-errors (delete-file tmp-name1)) |
| 7018 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) | 6935 | (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) |
| 7019 | 6936 | ||
| 7020 | ;; The functions were introduced in Emacs 28.1. | ||
| 7021 | (ert-deftest tramp-test39-detect-external-change () | 6937 | (ert-deftest tramp-test39-detect-external-change () |
| 7022 | "Check that an external file modification is reported." | 6938 | "Check that an external file modification is reported." |
| 7023 | (skip-unless (tramp--test-enabled)) | 6939 | (skip-unless (tramp--test-enabled)) |
| 7024 | (skip-unless (not (tramp--test-ange-ftp-p))) | 6940 | (skip-unless (not (tramp--test-ange-ftp-p))) |
| 7025 | ;; Since Emacs 28.1. | ||
| 7026 | (skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p))) | ||
| 7027 | 6941 | ||
| 7028 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) | 6942 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) |
| 7029 | (dolist (create-lockfiles '(nil t)) | 6943 | (dolist (create-lockfiles '(nil t)) |
| @@ -7081,8 +6995,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 7081 | (should (file-locked-p tmp-name))))) | 6995 | (should (file-locked-p tmp-name))))) |
| 7082 | 6996 | ||
| 7083 | ;; `save-buffer' removes the file lock. | 6997 | ;; `save-buffer' removes the file lock. |
| 7084 | (cl-letf (((symbol-function #'yes-or-no-p) | 6998 | (cl-letf (((symbol-function #'yes-or-no-p) #'always) |
| 7085 | #'tramp-compat-always) | ||
| 7086 | ((symbol-function #'read-char-choice) | 6999 | ((symbol-function #'read-char-choice) |
| 7087 | (lambda (&rest _) ?y))) | 7000 | (lambda (&rest _) ?y))) |
| 7088 | (should (buffer-modified-p)) | 7001 | (should (buffer-modified-p)) |
| @@ -7127,12 +7040,6 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 7127 | (delete-directory tmp-file) | 7040 | (delete-directory tmp-file) |
| 7128 | (should-not (file-exists-p tmp-file)))) | 7041 | (should-not (file-exists-p tmp-file)))) |
| 7129 | 7042 | ||
| 7130 | (defun tramp--test-emacs28-p () | ||
| 7131 | "Check for Emacs version >= 28.1. | ||
| 7132 | Some semantics has been changed for there, without new functions | ||
| 7133 | or variables, so we check the Emacs version directly." | ||
| 7134 | (>= emacs-major-version 28)) | ||
| 7135 | |||
| 7136 | (defun tramp--test-emacs29-p () | 7043 | (defun tramp--test-emacs29-p () |
| 7137 | "Check for Emacs version >= 29.1. | 7044 | "Check for Emacs version >= 29.1. |
| 7138 | Some semantics has been changed for there, without new functions | 7045 | Some semantics has been changed for there, without new functions |
| @@ -7729,7 +7636,7 @@ This requires restrictions of file name syntax." | |||
| 7729 | 7636 | ||
| 7730 | (when-let ((fsi (file-system-info ert-remote-temporary-file-directory))) | 7637 | (when-let ((fsi (file-system-info ert-remote-temporary-file-directory))) |
| 7731 | (should (consp fsi)) | 7638 | (should (consp fsi)) |
| 7732 | (should (tramp-compat-length= fsi 3)) | 7639 | (should (length= fsi 3)) |
| 7733 | (dotimes (i (length fsi)) | 7640 | (dotimes (i (length fsi)) |
| 7734 | (should (natnump (or (nth i fsi) 0)))))) | 7641 | (should (natnump (or (nth i fsi) 0)))))) |
| 7735 | 7642 | ||
| @@ -8322,8 +8229,6 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 8322 | (macrop x)) | 8229 | (macrop x)) |
| 8323 | (string-prefix-p "tramp" (symbol-name x)) | 8230 | (string-prefix-p "tramp" (symbol-name x)) |
| 8324 | (string-match-p (rx bol "with" (| "tramp" "parsed")) (symbol-name x)) | 8231 | (string-match-p (rx bol "with" (| "tramp" "parsed")) (symbol-name x)) |
| 8325 | ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. | ||
| 8326 | (not (eq 'tramp-completion-mode x)) | ||
| 8327 | ;; `tramp-register-archive-file-name-handler' is autoloaded | 8232 | ;; `tramp-register-archive-file-name-handler' is autoloaded |
| 8328 | ;; in Emacs < 29.1. | 8233 | ;; in Emacs < 29.1. |
| 8329 | (not (eq 'tramp-register-archive-file-name-handler x)) | 8234 | (not (eq 'tramp-register-archive-file-name-handler x)) |