master 926e3fb3be5: Tramp cleanup

[Michael Albinus]

branch: master
commit 926e3fb3be5c84e71316c6f184abe05bdb29bff2
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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.
---
 lisp/net/tramp-gvfs.el       |  21 +--
 test/lisp/net/tramp-tests.el | 379 ++++++++++++++++++++++---------------------
 2 files changed, 203 insertions(+), 197 deletions(-)

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 02ceb2979f7..b9639c1e7f7 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -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
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 97fada91fa2..f19847b0103 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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)))
-
-      ;; (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)
+  (skip-unless (not (memq system-type '(cygwin windows-nt))))
+  (tramp-cleanup-connection tramp-test-vec nil 'keep-password)
 
-            (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)))
-
-             (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
-                     (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))))))
-
-                    (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: "))
-
-                    (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)))
-
-                      (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)))
-
-                      ;; (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))))))))
+  (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)))
+
+    ;; (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)
+
+          (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)))
+
+           (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)
+
+               (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)))))
+
+                  (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: "))
+
+                  (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))))))))
+
+                    (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)))
+
+                    ;; (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)))))
+      ;; 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)))))))))