diff options
| author | Michael Albinus | 2017-08-22 16:22:33 +0200 |
|---|---|---|
| committer | Michael Albinus | 2017-08-22 16:22:33 +0200 |
| commit | 336707efb3d173c396ac522490ef2b1b6664eebf (patch) | |
| tree | 38fcba9e9fe74e9adf11e3101d6832553e5ad43a | |
| parent | ee9392a699a5b674388e650c61405cbe3b94e852 (diff) | |
| download | emacs-336707efb3d173c396ac522490ef2b1b6664eebf.tar.gz emacs-336707efb3d173c396ac522490ef2b1b6664eebf.zip | |
Test `file-expand-wildcards' for Tramp
* lisp/net/tramp-compat.el (tramp-advice-file-expand-wildcards):
Remove, not needed anymore.
* test/lisp/net/tramp-tests.el (top): Require seq.el.
(tramp-test16-directory-files): Simplify.
(tramp-test16-file-expand-wildcards): New test.
(tramp-test28-interrupt-process): Skip for older Emacsen.
| -rw-r--r-- | lisp/net/tramp-compat.el | 27 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 58 |
2 files changed, 56 insertions, 29 deletions
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b2df4d6324b..9a50d624487 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -50,33 +50,6 @@ | |||
| 50 | `(when (functionp ,function) | 50 | `(when (functionp ,function) |
| 51 | (with-no-warnings (funcall ,function ,@arguments)))) | 51 | (with-no-warnings (funcall ,function ,@arguments)))) |
| 52 | 52 | ||
| 53 | ;; We currently use "[" and "]" in the filename format for IPv6 hosts | ||
| 54 | ;; of GNU Emacs. This means that Emacs wants to expand wildcards if | ||
| 55 | ;; `find-file-wildcards' is non-nil, and then barfs because no | ||
| 56 | ;; expansion could be found. We detect this situation and do | ||
| 57 | ;; something really awful: we have `file-expand-wildcards' return the | ||
| 58 | ;; original filename if it can't expand anything. Let's just hope | ||
| 59 | ;; that this doesn't break anything else. It is not needed anymore | ||
| 60 | ;; since GNU Emacs 23.2. | ||
| 61 | (unless (featurep 'files 'remote-wildcards) | ||
| 62 | (defadvice file-expand-wildcards | ||
| 63 | (around tramp-advice-file-expand-wildcards activate) | ||
| 64 | (let ((name (ad-get-arg 0))) | ||
| 65 | ;; If it's a Tramp file, look if wildcards need to be expanded | ||
| 66 | ;; at all. | ||
| 67 | (if (and | ||
| 68 | (tramp-tramp-file-p name) | ||
| 69 | (not (string-match "[[*?]" (file-remote-p name 'localname)))) | ||
| 70 | (setq ad-return-value (list name)) | ||
| 71 | ;; Otherwise, just run the original function. | ||
| 72 | ad-do-it))) | ||
| 73 | (add-hook | ||
| 74 | 'tramp-unload-hook | ||
| 75 | (lambda () | ||
| 76 | (ad-remove-advice | ||
| 77 | 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) | ||
| 78 | (ad-activate 'file-expand-wildcards)))) | ||
| 79 | |||
| 80 | (defsubst tramp-compat-temporary-file-directory () | 53 | (defsubst tramp-compat-temporary-file-directory () |
| 81 | "Return name of directory for temporary files. | 54 | "Return name of directory for temporary files. |
| 82 | It is the default value of `temporary-file-directory'." | 55 | It is the default value of `temporary-file-directory'." |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 129bc1d65da..85ed6467220 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -39,6 +39,7 @@ | |||
| 39 | 39 | ||
| 40 | (require 'dired) | 40 | (require 'dired) |
| 41 | (require 'ert) | 41 | (require 'ert) |
| 42 | (require 'seq) | ||
| 42 | (require 'tramp) | 43 | (require 'tramp) |
| 43 | (require 'vc) | 44 | (require 'vc) |
| 44 | (require 'vc-bzr) | 45 | (require 'vc-bzr) |
| @@ -2145,8 +2146,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 2145 | (skip-unless (tramp--test-enabled)) | 2146 | (skip-unless (tramp--test-enabled)) |
| 2146 | 2147 | ||
| 2147 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) | 2148 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) |
| 2148 | (let* ((tmp-name1 | 2149 | (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) |
| 2149 | (expand-file-name (tramp--test-make-temp-name nil quoted))) | ||
| 2150 | (tmp-name2 (expand-file-name "bla" tmp-name1)) | 2150 | (tmp-name2 (expand-file-name "bla" tmp-name1)) |
| 2151 | (tmp-name3 (expand-file-name "foo" tmp-name1))) | 2151 | (tmp-name3 (expand-file-name "foo" tmp-name1))) |
| 2152 | (unwind-protect | 2152 | (unwind-protect |
| @@ -2172,6 +2172,58 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 2172 | ;; Cleanup. | 2172 | ;; Cleanup. |
| 2173 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) | 2173 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) |
| 2174 | 2174 | ||
| 2175 | ;; This is not a file name handler test. But Tramp needed to apply an | ||
| 2176 | ;; advice for older Emacs versions, so we check that this has been fixed. | ||
| 2177 | (ert-deftest tramp-test16-file-expand-wildcards () | ||
| 2178 | "Check `file-expand-wildcards'." | ||
| 2179 | (skip-unless (tramp--test-enabled)) | ||
| 2180 | |||
| 2181 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) | ||
| 2182 | (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) | ||
| 2183 | (tmp-name2 (expand-file-name "foo" tmp-name1)) | ||
| 2184 | (tmp-name3 (expand-file-name "bar" tmp-name1)) | ||
| 2185 | (tmp-name4 (expand-file-name "baz" tmp-name1)) | ||
| 2186 | (default-directory tmp-name1)) | ||
| 2187 | (unwind-protect | ||
| 2188 | (progn | ||
| 2189 | (make-directory tmp-name1) | ||
| 2190 | (write-region "foo" nil tmp-name2) | ||
| 2191 | (write-region "bar" nil tmp-name3) | ||
| 2192 | (write-region "baz" nil tmp-name4) | ||
| 2193 | (should (file-directory-p tmp-name1)) | ||
| 2194 | (should (file-exists-p tmp-name2)) | ||
| 2195 | (should (file-exists-p tmp-name3)) | ||
| 2196 | (should (file-exists-p tmp-name4)) | ||
| 2197 | |||
| 2198 | ;; We cannot use `sort', it works destructive. | ||
| 2199 | (should (equal (file-expand-wildcards "*") | ||
| 2200 | (seq-sort 'string< '("foo" "bar" "baz")))) | ||
| 2201 | (should (equal (file-expand-wildcards "ba?") | ||
| 2202 | (seq-sort 'string< '("bar" "baz")))) | ||
| 2203 | (should (equal (file-expand-wildcards "ba[rz]") | ||
| 2204 | (seq-sort 'string< '("bar" "baz")))) | ||
| 2205 | |||
| 2206 | (should (equal (file-expand-wildcards "*" 'full) | ||
| 2207 | (seq-sort | ||
| 2208 | 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) | ||
| 2209 | (should (equal (file-expand-wildcards "ba?" 'full) | ||
| 2210 | (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) | ||
| 2211 | (should (equal (file-expand-wildcards "ba[rz]" 'full) | ||
| 2212 | (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) | ||
| 2213 | |||
| 2214 | (should (equal (file-expand-wildcards (concat tmp-name1 "/" "*")) | ||
| 2215 | (seq-sort | ||
| 2216 | 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) | ||
| 2217 | (should (equal (file-expand-wildcards (concat tmp-name1 "/" "ba?")) | ||
| 2218 | (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) | ||
| 2219 | (should (equal (file-expand-wildcards | ||
| 2220 | (concat tmp-name1 "/" "ba[rz]")) | ||
| 2221 | (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))) | ||
| 2222 | |||
| 2223 | ;; Cleanup. | ||
| 2224 | (ignore-errors | ||
| 2225 | (delete-directory tmp-name1)))))) | ||
| 2226 | |||
| 2175 | (ert-deftest tramp-test17-insert-directory () | 2227 | (ert-deftest tramp-test17-insert-directory () |
| 2176 | "Check `insert-directory'." | 2228 | "Check `insert-directory'." |
| 2177 | (skip-unless (tramp--test-enabled)) | 2229 | (skip-unless (tramp--test-enabled)) |
| @@ -2905,6 +2957,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 2905 | :tags '(:expensive-test) | 2957 | :tags '(:expensive-test) |
| 2906 | (skip-unless (tramp--test-enabled)) | 2958 | (skip-unless (tramp--test-enabled)) |
| 2907 | (skip-unless (tramp--test-sh-p)) | 2959 | (skip-unless (tramp--test-sh-p)) |
| 2960 | ;; Since Emacs 26.1. | ||
| 2961 | (skip-unless (boundp 'interrupt-process-functions)) | ||
| 2908 | 2962 | ||
| 2909 | (let ((default-directory tramp-test-temporary-file-directory) | 2963 | (let ((default-directory tramp-test-temporary-file-directory) |
| 2910 | kill-buffer-query-functions proc) | 2964 | kill-buffer-query-functions proc) |