Fix a Tramp bug when running several asynchronous processes

* lisp/net/tramp-cache.el (tramp-get-hash-table):
Add ;;;###tramp-autoload cookie.

* lisp/net/tramp.el (tramp-file-name-handler): Flush connection
properties "process-name" and "process-buffer".

* test/lisp/net/tramp-tests.el
(tramp--test-deftest-direct-async-process): Skip when underlying
TEST has taken too much time.
(tramp--test-with-proper-process-name-and-buffer): Remove.
(tramp-test45-asynchronous-requests): Remove callees.

(cherry picked from commit 0b7f649614d8eb7694e98372dea7b7e01f090265)

diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 85a318b8a933ccc556142ce68da2abcbd0b86df2..c50fbdad5f1dcff06d5efb26d77f783c3322227e 100644 (file)
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -122,6 +122,7 @@ details see the info pages."
 (defconst tramp-cache-undefined 'undef
   "The symbol marking undefined hash keys and values.")
 
+;;;###tramp-autoload
 (defun tramp-get-hash-table (key)
   "Return the hash table for KEY.
 If it doesn't exist yet, it is created and initialized with

diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 1031e71a9946f79f0055a94fceb59341d8d631bb..d9667ebfa5af847aaeff651cee2a87b7690c38b0 100644 (file)
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -254,10 +254,10 @@ arguments to pass to the OPERATION."
     (let ((coding-system-for-read 'utf-8-dos)) ; Is this correct?
 
       (setq command
-          (format
-           "cd %s && exec %s"
-           (tramp-unquote-shell-quote-argument localname)
-           (mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
+           (format
+            "cd %s && exec %s"
+            (tramp-unquote-shell-quote-argument localname)
+            (mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
       (when input (setq command (format "%s <%s" command input)))
       (when stderr (setq command (format "%s 2>%s" command stderr)))
 

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 1ec3d55d8654594264fbd3915bb83bf12a1139d4..cdff2cf1ae87e69cbebc00fb9e80865c61d5df9e 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2469,6 +2469,10 @@ Fall back to normal file name handler if no Tramp file name handler exists."
                            (autoload-do-load sf foreign)))
                        (with-tramp-debug-message
                            v (format "Running `%S'" (cons operation args))
+                         ;; We flush connection properties
+                         ;; "process-name" and "process-buffer",
+                         ;; because the operations shall be applied
+                         ;; in the main connection process.
                           ;; If `non-essential' is non-nil, Tramp shall
                          ;; not open a new connection.
                          ;; If Tramp detects that it shouldn't continue
@@ -2477,10 +2481,14 @@ Fall back to normal file name handler if no Tramp file name handler exists."
                          ;; tries to open the same connection twice in
                          ;; a short time frame.
                          ;; In both cases, we try the default handler then.
-                         (setq result
-                               (catch 'non-essential
-                                 (catch 'suppress
-                                   (apply foreign operation args)))))
+                         (with-tramp-saved-connection-properties
+                             v '("process-name" "process-buffer")
+                           (tramp-flush-connection-property v "process-name")
+                           (tramp-flush-connection-property v "process-buffer")
+                           (setq result
+                                 (catch 'non-essential
+                                   (catch 'suppress
+                                     (apply foreign operation args))))))
                        (cond
                         ((eq result 'non-essential)
                          (tramp-message

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f2f466bf05be6e4ba4bab89a7759b7bf3733fdb1..768adf3d6299140df8b19195fdc799385cc310d6 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5090,6 +5090,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
                direct-async-process-profile)
              connection-local-criteria-alist)))
        (skip-unless (tramp-direct-async-process-p))
+       (when-let ((result (ert-test-most-recent-result ert-test)))
+        (skip-unless (< (ert-test-result-duration result) 300)))
        ;; We do expect an established connection already,
        ;; `file-truename' does it by side-effect.  Suppress
        ;; `tramp--test-enabled', in order to keep the connection.
@@ -7368,39 +7370,6 @@ should all return proper values."
 (defconst tramp--test-asynchronous-requests-timeout 300
   "Timeout for `tramp-test45-asynchronous-requests'.")
 
-(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
-  "Set \"process-name\" and \"process-buffer\" connection properties.
-The values are derived from PROC.  Run BODY.
-This is needed in timer functions as well as process filters and sentinels."
-  ;; FIXME: For tramp-sshfs.el, `processp' does not work.
-  (declare (indent 1) (debug (processp body)))
-  `(let* ((v (tramp-get-connection-property ,proc "vector"))
-         (pname (tramp-get-connection-property v "process-name"))
-         (pbuffer (tramp-get-connection-property v "process-buffer")))
-     (tramp--test-message
-      "tramp--test-with-proper-process-name-and-buffer before %s %s"
-      (tramp-get-connection-property v "process-name")
-      (tramp-get-connection-property v "process-buffer"))
-     (if (process-name ,proc)
-        (tramp-set-connection-property v "process-name" (process-name ,proc))
-       (tramp-flush-connection-property v "process-name"))
-     (if (process-buffer ,proc)
-        (tramp-set-connection-property
-         v "process-buffer" (process-buffer ,proc))
-       (tramp-flush-connection-property v "process-buffer"))
-     (tramp--test-message
-      "tramp--test-with-proper-process-name-and-buffer changed %s %s"
-      (tramp-get-connection-property v "process-name")
-      (tramp-get-connection-property v "process-buffer"))
-     (unwind-protect
-        (progn ,@body)
-       (if pname
-          (tramp-set-connection-property v "process-name" pname)
-        (tramp-flush-connection-property v "process-name"))
-       (if pbuffer
-          (tramp-set-connection-property v "process-buffer" pbuffer)
-        (tramp-flush-connection-property v "process-buffer")))))
-
 ;; This test is inspired by Bug#16928.
 (ert-deftest tramp-test45-asynchronous-requests ()
   "Check parallel asynchronous requests.
@@ -7470,29 +7439,27 @@ process sentinels.  They shall not disturb each other."
              (run-at-time
               0 timer-repeat
               (lambda ()
-                (tramp--test-with-proper-process-name-and-buffer
-                    (get-buffer-process (tramp-get-buffer tramp-test-vec))
-                  (when (> (- (time-to-seconds) (time-to-seconds timer-start))
-                           tramp--test-asynchronous-requests-timeout)
-                    (tramp--test-timeout-handler))
-                  (when buffers
-                    (let ((time (float-time))
-                          (default-directory tmp-name)
-                          (file (buffer-name (seq-random-elt buffers))))
-                      (tramp--test-message
-                       "Start timer %s %s" file (current-time-string))
-                     (dired-uncache file)
-                     (tramp--test-message
-                      "Continue timer %s %s" file (file-attributes file))
-                     (vc-registered file)
+                (when (> (- (time-to-seconds) (time-to-seconds timer-start))
+                         tramp--test-asynchronous-requests-timeout)
+                  (tramp--test-timeout-handler))
+                (when buffers
+                  (let ((time (float-time))
+                        (default-directory tmp-name)
+                        (file (buffer-name (seq-random-elt buffers))))
+                    (tramp--test-message
+                    "Start timer %s %s" file (current-time-string))
+                   (dired-uncache file)
+                   (tramp--test-message
+                    "Continue timer %s %s" file (file-attributes file))
+                   (vc-registered file)
+                    (tramp--test-message
+                     "Stop timer %s %s" file (current-time-string))
+                    ;; Adjust timer if it takes too much time.
+                    (when (> (- (float-time) time) timer-repeat)
+                      (setq timer-repeat (* 1.1 (- (float-time) time)))
+                      (setf (timer--repeat-delay timer) timer-repeat)
                       (tramp--test-message
-                       "Stop timer %s %s" file (current-time-string))
-                      ;; Adjust timer if it takes too much time.
-                      (when (> (- (float-time) time) timer-repeat)
-                        (setq timer-repeat (* 1.1 (- (float-time) time)))
-                        (setf (timer--repeat-delay timer) timer-repeat)
-                        (tramp--test-message
-                         "Increase timer %s" timer-repeat))))))))
+                      "Increase timer %s" timer-repeat)))))))
 
             ;; Create temporary buffers.  The number of buffers
             ;; corresponds to the number of processes; it could be
@@ -7519,23 +7486,21 @@ process sentinels.  They shall not disturb each other."
                 (set-process-filter
                  proc
                  (lambda (proc string)
-                  (tramp--test-with-proper-process-name-and-buffer proc
-                     (tramp--test-message
-                      "Process filter %s %s %s"
-                     proc string (current-time-string))
-                     (with-current-buffer (process-buffer proc)
-                       (insert string))
-                     (when (< (process-get proc 'bar) 2)
-                      (dired-uncache (process-get proc 'foo))
-                       (should (file-attributes (process-get proc 'foo)))))))
+                   (tramp--test-message
+                    "Process filter %s %s %s"
+                   proc string (current-time-string))
+                   (with-current-buffer (process-buffer proc)
+                     (insert string))
+                   (when (< (process-get proc 'bar) 2)
+                    (dired-uncache (process-get proc 'foo))
+                     (should (file-attributes (process-get proc 'foo))))))
                 ;; Add process sentinel.  It shall not perform remote
                 ;; operations, triggering Tramp processes.  This blocks.
                 (set-process-sentinel
                  proc
                  (lambda (proc _state)
-                  (tramp--test-with-proper-process-name-and-buffer proc
-                     (tramp--test-message
-                      "Process sentinel %s %s" proc (current-time-string)))))
+                   (tramp--test-message
+                    "Process sentinel %s %s" proc (current-time-string))))
                (tramp--test-message "Process started %s" proc)))
 
             ;; Send a string to the processes.  Use a random order of