mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
Tramp cleanup
* lisp/net/tramp-gvfs.el (tramp-gvfs-parse-device-names): Ignore errors. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion) (tramp-test26-interactive-file-name-completion) (tramp-test29-start-file-process, tramp-test30-make-process): Fix tests.
This commit is contained in:
Michael Albinus
parent
b5edfdbf86
commit
926e3fb3be
2 changed files with 196 additions and 190 deletions
|
|
@ -2467,16 +2467,17 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
|
|||
(delete-dups
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(let* ((list (split-string x ";"))
|
||||
(host (nth 6 list))
|
||||
(text (split-string (nth 9 list) "\" \"" 'omit "\""))
|
||||
user)
|
||||
;; A user is marked in a TXT field like "u=guest".
|
||||
(while text
|
||||
(when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
|
||||
(setq user (match-string 1 (car text))))
|
||||
(setq text (cdr text)))
|
||||
(list user host)))
|
||||
(ignore-errors
|
||||
(let* ((list (split-string x ";"))
|
||||
(host (nth 6 list))
|
||||
(text (split-string (nth 9 list) "\" \"" 'omit "\""))
|
||||
user)
|
||||
;; A user is marked in a TXT field like "u=guest".
|
||||
(while text
|
||||
(when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
|
||||
(setq user (match-string 1 (car text))))
|
||||
(setq text (cdr text)))
|
||||
(list user host))))
|
||||
result))))
|
||||
|
||||
(when tramp-gvfs-enabled
|
||||
|
|
|
|||
|
|
@ -4557,8 +4557,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
|
|||
;; 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)
|
||||
(tramp--test-gvfs-p method))
|
||||
(tramp-string-empty-or-nil-p host))
|
||||
(should
|
||||
(member
|
||||
(concat
|
||||
|
|
@ -4640,171 +4639,181 @@ 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'."
|
||||
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
|
||||
|
||||
;; Method, user and host name in completion mode. This kind of
|
||||
;; completion does not work on MS Windows.
|
||||
(unless (memq system-type '(cygwin windows-nt))
|
||||
(let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
|
||||
(user (file-remote-p ert-remote-temporary-file-directory 'user))
|
||||
(host (file-remote-p ert-remote-temporary-file-directory 'host))
|
||||
(hop (file-remote-p ert-remote-temporary-file-directory 'hop))
|
||||
(orig-syntax tramp-syntax)
|
||||
(non-essential t)
|
||||
(inhibit-message t))
|
||||
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
|
||||
(setq host (match-string 1 host)))
|
||||
(skip-unless (not (memq system-type '(cygwin windows-nt))))
|
||||
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
|
||||
|
||||
;; (trace-function #'tramp-completion-file-name-handler)
|
||||
;; (trace-function #'completion-file-name-table)
|
||||
(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 ((method (file-remote-p ert-remote-temporary-file-directory 'method))
|
||||
(user (file-remote-p ert-remote-temporary-file-directory 'user))
|
||||
(host (file-remote-p ert-remote-temporary-file-directory 'host))
|
||||
(hop (file-remote-p ert-remote-temporary-file-directory 'hop))
|
||||
(orig-syntax tramp-syntax)
|
||||
(non-essential t)
|
||||
(inhibit-message t))
|
||||
(when (and (stringp host) (string-match tramp-host-with-port-regexp host))
|
||||
(setq host (match-string 1 host)))
|
||||
|
||||
(dolist
|
||||
(style
|
||||
(if (tramp--test-expensive-test-p)
|
||||
;; It doesn't work for `initials' and `shorthand'
|
||||
;; completion styles. Should it?
|
||||
'(emacs21 emacs22 basic partial-completion substring flex)
|
||||
'(basic)))
|
||||
;; (trace-function #'tramp-completion-file-name-handler)
|
||||
;; (trace-function #'completion-file-name-table)
|
||||
(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)
|
||||
|
||||
(when (assoc style completion-styles-alist)
|
||||
(let (;; Force the real minibuffer in batch mode.
|
||||
(executing-kbd-macro noninteractive)
|
||||
(completion-styles `(,style))
|
||||
(completions-format 'one-column)
|
||||
completion-category-defaults
|
||||
completion-category-overrides
|
||||
;; This is needed for the `simplified' syntax,
|
||||
(tramp-default-method method)
|
||||
(method-string
|
||||
(unless (string-empty-p tramp-method-regexp)
|
||||
(concat method tramp-postfix-method-format)))
|
||||
;; 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))
|
||||
;; The hop string fits only the initial syntax.
|
||||
(hop (and (eq tramp-syntax orig-syntax) hop))
|
||||
test result completions)
|
||||
(dolist
|
||||
(style
|
||||
(if (tramp--test-expensive-test-p)
|
||||
;; It doesn't work for `initials' and `shorthand'
|
||||
;; completion styles. Should it?
|
||||
'(emacs21 emacs22 basic partial-completion substring flex)
|
||||
'(basic)))
|
||||
|
||||
(dolist
|
||||
(test-and-result
|
||||
;; These are triples (TEST-STRING RESULT-CHECK
|
||||
;; COMPLETION-CHECK).
|
||||
(append
|
||||
;; Complete method name.
|
||||
(unless (string-empty-p tramp-method-regexp)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop
|
||||
(substring-no-properties
|
||||
method 0 (min 2 (length method))))
|
||||
,(concat tramp-prefix-format method-string)
|
||||
,method-string)))
|
||||
;; Complete user name.
|
||||
(unless (tramp-string-empty-or-nil-p user)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string
|
||||
(substring-no-properties
|
||||
user 0 (min 2 (length user))))
|
||||
,(concat
|
||||
tramp-prefix-format method-string
|
||||
user tramp-postfix-user-format)
|
||||
,(concat
|
||||
user tramp-postfix-user-format))))
|
||||
;; Complete host name.
|
||||
(unless (tramp-string-empty-or-nil-p host)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string
|
||||
ipv6-prefix
|
||||
(substring-no-properties
|
||||
host 0 (min 2 (length host))))
|
||||
,(concat
|
||||
tramp-prefix-format method-string
|
||||
ipv6-prefix host
|
||||
ipv6-postfix tramp-postfix-host-format)
|
||||
,(concat
|
||||
ipv6-prefix host
|
||||
ipv6-postfix tramp-postfix-host-format))))
|
||||
;; Complete user and host name.
|
||||
(unless (or (tramp-string-empty-or-nil-p user)
|
||||
(tramp-string-empty-or-nil-p host))
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string
|
||||
user tramp-postfix-user-format
|
||||
ipv6-prefix
|
||||
(substring-no-properties
|
||||
host 0 (min 2 (length host))))
|
||||
,(concat
|
||||
tramp-prefix-format method-string
|
||||
user tramp-postfix-user-format
|
||||
ipv6-prefix host
|
||||
ipv6-postfix tramp-postfix-host-format)
|
||||
,(concat
|
||||
ipv6-prefix host
|
||||
ipv6-postfix tramp-postfix-host-format))))))
|
||||
(when (assoc style completion-styles-alist)
|
||||
(let* (;; Force the real minibuffer in batch mode.
|
||||
(executing-kbd-macro noninteractive)
|
||||
(completion-styles `(,style))
|
||||
completion-category-defaults
|
||||
completion-category-overrides
|
||||
;; This is needed for the `simplified' syntax,
|
||||
(tramp-default-method method)
|
||||
(method-string
|
||||
(unless (string-empty-p tramp-method-regexp)
|
||||
(concat method tramp-postfix-method-format)))
|
||||
(user-string
|
||||
(unless (tramp-string-empty-or-nil-p user)
|
||||
(concat user tramp-postfix-user-format)))
|
||||
;; 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))
|
||||
(host-string
|
||||
(unless (tramp-string-empty-or-nil-p host)
|
||||
(concat
|
||||
ipv6-prefix host
|
||||
ipv6-postfix tramp-postfix-host-format)))
|
||||
;; The hop string fits only the initial syntax.
|
||||
(hop (and (eq tramp-syntax orig-syntax) hop))
|
||||
test result completions)
|
||||
|
||||
(ignore-errors (kill-buffer "*Completions*"))
|
||||
;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
|
||||
(discard-input)
|
||||
(setq test (car test-and-result)
|
||||
unread-command-events
|
||||
(mapcar #'identity (concat test "\t\t\n"))
|
||||
completions nil
|
||||
result (read-file-name "Prompt: "))
|
||||
(dolist
|
||||
(test-and-result
|
||||
;; These are triples of strings (TEST-STRING
|
||||
;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK
|
||||
;; could be not unique, in this case it is a list
|
||||
;; (RESULT1 RESULT2 ...).
|
||||
(append
|
||||
;; Complete method name.
|
||||
(unless (string-empty-p tramp-method-regexp)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop
|
||||
(substring-no-properties
|
||||
method 0 (min 2 (length method))))
|
||||
,(concat tramp-prefix-format method-string)
|
||||
,method-string)))
|
||||
;; Complete user name.
|
||||
(unless (tramp-string-empty-or-nil-p user)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string
|
||||
(substring-no-properties
|
||||
user 0 (min 2 (length user))))
|
||||
,(concat
|
||||
tramp-prefix-format method-string user-string)
|
||||
,user-string)))
|
||||
;; Complete host name.
|
||||
(unless (tramp-string-empty-or-nil-p host)
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string
|
||||
ipv6-prefix
|
||||
(substring-no-properties
|
||||
host 0 (min 2 (length host))))
|
||||
(,(concat
|
||||
tramp-prefix-format method-string host-string)
|
||||
,(concat
|
||||
tramp-prefix-format method-string
|
||||
user-string host-string))
|
||||
,host-string)))
|
||||
;; Complete user and host name.
|
||||
(unless (or (tramp-string-empty-or-nil-p user)
|
||||
(tramp-string-empty-or-nil-p host))
|
||||
`((,(concat
|
||||
tramp-prefix-format hop method-string user-string
|
||||
ipv6-prefix
|
||||
(substring-no-properties
|
||||
host 0 (min 2 (length host))))
|
||||
,(concat
|
||||
tramp-prefix-format method-string
|
||||
user-string host-string)
|
||||
,host-string)))))
|
||||
|
||||
(if (or (not (get-buffer "*Completions*"))
|
||||
(string-match-p
|
||||
(if (string-empty-p tramp-method-regexp)
|
||||
(rx (| (regexp tramp-postfix-user-regexp)
|
||||
(regexp tramp-postfix-host-regexp))
|
||||
eos)
|
||||
(rx (| (regexp tramp-postfix-method-regexp)
|
||||
(regexp tramp-postfix-user-regexp)
|
||||
(regexp tramp-postfix-host-regexp))
|
||||
eos))
|
||||
result))
|
||||
(progn
|
||||
;; (tramp--test-message
|
||||
;; "syntax: %s style: %s test: %s result: %s"
|
||||
;; syntax style test result)
|
||||
(should (string-prefix-p (cadr test-and-result) result)))
|
||||
(ignore-errors (kill-buffer "*Completions*"))
|
||||
;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
|
||||
(discard-input)
|
||||
(setq test (car test-and-result)
|
||||
unread-command-events
|
||||
(mapcar #'identity (concat test "\t\t\n"))
|
||||
completions nil
|
||||
result (read-file-name "Prompt: "))
|
||||
|
||||
(with-current-buffer "*Completions*"
|
||||
;; We must remove leading `default-directory'.
|
||||
(goto-char (point-min))
|
||||
(let ((inhibit-read-only t))
|
||||
(while (re-search-forward "//" nil 'noerror)
|
||||
(delete-region (line-beginning-position) (point))))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward
|
||||
(rx bol (0+ nonl)
|
||||
(any "Pp") "ossible completions"
|
||||
(0+ nonl) eol))
|
||||
(forward-line 1)
|
||||
(setq completions
|
||||
(split-string
|
||||
(buffer-substring-no-properties (point) (point-max))
|
||||
(rx (any "\r\n")) 'omit)))
|
||||
(if (or (not (get-buffer "*Completions*"))
|
||||
(string-match-p
|
||||
(if (string-empty-p tramp-method-regexp)
|
||||
(rx
|
||||
(| (regexp tramp-postfix-user-regexp)
|
||||
(regexp tramp-postfix-host-regexp))
|
||||
eos)
|
||||
(rx
|
||||
(| (regexp tramp-postfix-method-regexp)
|
||||
(regexp tramp-postfix-user-regexp)
|
||||
(regexp tramp-postfix-host-regexp))
|
||||
eos))
|
||||
result))
|
||||
(progn
|
||||
;; (tramp--test-message
|
||||
;; "syntax: %s style: %s test: %s result: %s"
|
||||
;; syntax style test result)
|
||||
(if (stringp (cadr test-and-result))
|
||||
(should
|
||||
(string-prefix-p (cadr test-and-result) result))
|
||||
(should
|
||||
(let (res)
|
||||
(dolist (elem (cadr test-and-result) res)
|
||||
(setq
|
||||
res (or res (string-prefix-p elem result))))))))
|
||||
|
||||
;; (tramp--test-message
|
||||
;; "syntax: %s style: %s test: %s result: %s completions: %S"
|
||||
;; syntax style test result completions)
|
||||
(should (member (caddr test-and-result) completions))))))))
|
||||
(with-current-buffer "*Completions*"
|
||||
;; We must remove leading `default-directory'.
|
||||
(goto-char (point-min))
|
||||
(let ((inhibit-read-only t))
|
||||
(while (re-search-forward "//" nil 'noerror)
|
||||
(delete-region (line-beginning-position) (point))))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward
|
||||
(rx bol (0+ nonl)
|
||||
(any "Pp") "ossible completions"
|
||||
(0+ nonl) eol))
|
||||
(forward-line 1)
|
||||
(setq completions
|
||||
(split-string
|
||||
(buffer-substring-no-properties (point) (point-max))
|
||||
(rx (any "\r\n\t ")) 'omit)))
|
||||
|
||||
;; Cleanup.
|
||||
;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
|
||||
;; (untrace-function #'tramp-completion-file-name-handler)
|
||||
;; (untrace-function #'completion-file-name-table)
|
||||
(tramp-change-syntax orig-syntax)))))
|
||||
;; (tramp--test-message
|
||||
;; "syntax: %s style: %s test: %s result: %s completions: %S"
|
||||
;; syntax style test result completions)
|
||||
(should (member (caddr test-and-result) completions))))))))
|
||||
|
||||
;; Cleanup.
|
||||
;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
|
||||
;; (untrace-function #'tramp-completion-file-name-handler)
|
||||
;; (untrace-function #'completion-file-name-table)
|
||||
(tramp-change-syntax orig-syntax))))
|
||||
|
||||
(ert-deftest tramp-test27-load ()
|
||||
"Check `load'."
|
||||
|
|
@ -5097,18 +5106,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
|
|||
(sit-for 0.1 'nodisp))
|
||||
(process-send-string proc "foo\r\n")
|
||||
(process-send-eof proc)
|
||||
;; Read output.
|
||||
(with-timeout (10 (tramp--test-timeout-handler))
|
||||
(while (< (- (point-max) (point-min))
|
||||
(length "66\n6F\n6F\n0D\n0A\n"))
|
||||
(while (accept-process-output proc 0 nil t))))
|
||||
(should
|
||||
(string-match-p
|
||||
;; On macOS, there is always newline conversion.
|
||||
;; "telnet" converts \r to <CR><NUL> if `crlf'
|
||||
;; flag is FALSE. See telnet(1) man page.
|
||||
(rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
|
||||
(buffer-string))))
|
||||
;; Read output. On macOS, there is always newline
|
||||
;; conversion. "telnet" converts \r to <CR><NUL> if
|
||||
;; `crlf' flag is FALSE. See telnet(1) man page.
|
||||
(let ((expected
|
||||
(rx "66\n" "6F\n" "6F\n"
|
||||
(| "0D\n" "0A\n") (? "00\n") "0A\n")))
|
||||
(with-timeout (10 (tramp--test-timeout-handler))
|
||||
(while (not (string-match-p expected (buffer-string)))
|
||||
(while (accept-process-output proc 0 nil t))))
|
||||
(should (string-match-p expected (buffer-string)))))
|
||||
|
||||
;; Cleanup.
|
||||
(ignore-errors (delete-process proc)))))
|
||||
|
|
@ -5388,18 +5395,16 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
|
|||
(sit-for 0.1 'nodisp))
|
||||
(process-send-string proc "foo\r\n")
|
||||
(process-send-eof proc)
|
||||
;; Read output.
|
||||
(with-timeout (10 (tramp--test-timeout-handler))
|
||||
(while (< (- (point-max) (point-min))
|
||||
(length "66\n6F\n6F\n0D\n0A\n"))
|
||||
(while (accept-process-output proc 0 nil t))))
|
||||
(should
|
||||
(string-match-p
|
||||
;; On macOS, there is always newline conversion.
|
||||
;; "telnet" converts \r to <CR><NUL> if `crlf'
|
||||
;; flag is FALSE. See telnet(1) man page.
|
||||
(rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
|
||||
(buffer-string))))
|
||||
;; Read output. On macOS, there is always newline
|
||||
;; conversion. "telnet" converts \r to <CR><NUL> if
|
||||
;; `crlf' flag is FALSE. See telnet(1) man page.
|
||||
(let ((expected
|
||||
(rx "66\n" "6F\n" "6F\n"
|
||||
(| "0D\n" "0A\n") (? "00\n") "0A\n")))
|
||||
(with-timeout (10 (tramp--test-timeout-handler))
|
||||
(while (not (string-match-p expected (buffer-string)))
|
||||
(while (accept-process-output proc 0 nil t))))
|
||||
(should (string-match-p expected (buffer-string)))))
|
||||
|
||||
;; Cleanup.
|
||||
(ignore-errors (delete-process proc)))))))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue