From 9e745ed3f2c53f9ca46e763c8eac66a1cf8611c6 Mon Sep 17 00:00:00 2001
From: Michael Albinus <michael.albinus@gmx.de>
Date: Sun, 19 Feb 2023 18:35:46 +0100
Subject: [PATCH] Tramp cleanup
* lisp/net/tramp-smb.el (tramp-smb-action-get-acl)
(tramp-smb-action-set-acl): Use timeout.
* test/lisp/net/tramp-tests.el
(tramp-test26-interactive-file-name-completion): Fix test.
---
lisp/net/tramp-smb.el | 4 +-
test/lisp/net/tramp-tests.el | 243 ++++++++++++++++++-----------------
2 files changed, 130 insertions(+), 117 deletions(-)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b2272f804e0..2a69465224f 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -757,7 +757,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Read ACL data from connection buffer."
(unless (process-live-p proc)
;; Accept pending output.
- (while (tramp-accept-process-output proc))
+ (while (tramp-accept-process-output proc 0))
(with-current-buffer (tramp-get-connection-buffer vec)
;; There might be a hidden password prompt.
(widen)
@@ -1361,7 +1361,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Set ACL data."
(unless (process-live-p proc)
;; Accept pending output.
- (while (tramp-accept-process-output proc))
+ (while (tramp-accept-process-output proc 0))
(tramp-message
vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(throw 'tramp-action 'ok)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index d29e48c0774..97fada91fa2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4642,8 +4642,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check interactive completion with different `completion-styles'."
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
- ;; Method and host name in completion mode. This kind of completion
- ;; does not work on MS Windows.
+ ;; 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))
@@ -4673,119 +4673,132 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
'(emacs21 emacs22 basic partial-completion substring flex)
'(basic)))
- (let (;; Force the real minibuffer in batch mode.
- (executing-kbd-macro t)
- (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 (not (get-buffer "*Completions*"))
- (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 (1+ nonl) "possible completions:" 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)))))))
+ (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))))))))
;; Cleanup.
;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
--
2.39.5