[Emacs-diffs] master f63d9f8: Suppress timers in Tramp operations

[Michael Albinus]

branch: master
commit f63d9f86b5688ac84ec6e7eecdbb6cac103dbcf2
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Suppress timers in Tramp operations
    
    * lisp/net/tramp.el (tramp-accept-process-output):
    * lisp/net/tramp-adb.el (tramp-adb-handle-start-file-process):
    * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
    (tramp-sh-handle-start-file-process):
    * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
    (tramp-smb-handle-file-acl, tramp-smb-handle-process-file)
    (tramp-smb-handle-set-file-acl)
    (tramp-smb-handle-start-file-process): Suppress timers.
    
    * test/lisp/net/tramp-tests.el (tramp-test41-asynchronous-requests):
    Use $REMOTE_PARALLEL_PROCESSES.  Flush cache prior file operations.
    Add instrumentation messages.
---
 lisp/net/tramp-adb.el        |  4 +++-
 lisp/net/tramp-sh.el         |  8 ++++++--
 lisp/net/tramp-smb.el        | 18 ++++++++++++++----
 lisp/net/tramp.el            |  4 +++-
 test/lisp/net/tramp-tests.el | 23 +++++++++++++++++++++--
 5 files changed, 47 insertions(+), 10 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index d06031f..c614acf 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1037,7 +1037,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
            (or (null program) tramp-process-connection-type))
           (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
           (name1 name)
-          (i 0))
+          (i 0)
+          ;; We do not want to run timers.
+          timer-list timer-idle-list)
 
       (while (get-process name1)
        ;; NAME must be unique as process name.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 361e4c3..96a0d849 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2473,7 +2473,9 @@ The method used must be an out-of-band method."
              ;; The default directory must be remote.
              (let ((default-directory
                      (file-name-directory (if t1 filename newname)))
-                   (process-environment (copy-sequence process-environment)))
+                   (process-environment (copy-sequence process-environment))
+                   ;; We do not want to run timers.
+                   timer-list timer-idle-list)
                ;; Set the transfer process properties.
                (tramp-set-connection-property
                 v "process-name" (buffer-name (current-buffer)))
@@ -2894,7 +2896,9 @@ the result will be a local, non-Tramp, file name."
           ;; We do not want to raise an error when
           ;; `start-file-process' has been started several times in
           ;; `eshell' and friends.
-          (tramp-current-connection nil)
+          tramp-current-connection
+          ;; We do not want to run timers.
+          timer-list timer-idle-list
           p)
 
       (while (get-process name1)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index ec689ae..fee14df 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -457,7 +457,9 @@ pass to the OPERATION."
                               (expand-file-name
                                tramp-temp-name-prefix
                                (tramp-compat-temporary-file-directory))))
-                  (args      (list (concat "//" host "/" share) "-E")))
+                  (args      (list (concat "//" host "/" share) "-E"))
+                  ;; We do not want to run timers.
+                  timer-list timer-idle-list)
 
              (if (not (zerop (length user)))
                  (setq args (append args (list "-U" user)))
@@ -739,7 +741,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
          (let* ((share     (tramp-smb-get-share v))
                 (localname (replace-regexp-in-string
                             "\\\\" "/" (tramp-smb-get-localname v)))
-                (args      (list (concat "//" host "/" share) "-E")))
+                (args      (list (concat "//" host "/" share) "-E"))
+                ;; We do not want to run timers.
+                timer-list timer-idle-list)
 
            (if (not (zerop (length user)))
                (setq args (append args (list "-U" user)))
@@ -1215,6 +1219,8 @@ component is used as the target of the symlink."
     (let* ((name (file-name-nondirectory program))
           (name1 name)
           (i 0)
+          ;; We do not want to run timers.
+          timer-list timer-idle-list
           input tmpinput outbuf command ret)
 
       ;; Determine input.
@@ -1391,7 +1397,9 @@ component is used as the target of the symlink."
                           "\\\\" "/" (tramp-smb-get-localname v)))
               (args      (list (concat "//" host "/" share) "-E" "-S"
                                (replace-regexp-in-string
-                                "\n" "," acl-string))))
+                                "\n" "," acl-string)))
+              ;; We do not want to run timers.
+              timer-list timer-idle-list)
 
          (if (not (zerop (length user)))
              (setq args (append args (list "-U" user)))
@@ -1471,7 +1479,9 @@ component is used as the target of the symlink."
           (command (mapconcat 'identity (cons program args) " "))
           (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
           (name1 name)
-          (i 0))
+          (i 0)
+          ;; We do not want to run timers.
+          timer-list timer-idle-list)
       (unwind-protect
          (save-excursion
            (save-restriction
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3129984..01a3e44 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3833,7 +3833,9 @@ connection buffer."
 This is needed in order to hide `last-coding-system-used', which is set
 for process communication also."
   (with-current-buffer (process-buffer proc)
-    (let (buffer-read-only last-coding-system-used)
+    (let (buffer-read-only last-coding-system-used
+         ;; We do not want to run timers.
+         timer-list timer-idle-list)
       ;; Under Windows XP, `accept-process-output' doesn't return
       ;; sometimes.  So we add an additional timeout.  JUST-THIS-ONE
       ;; is set due to Bug#12145.  It is an integer, in order to avoid
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5fb3162..1bcd3a0 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,6 +33,10 @@
 ;; remote host, set this environment variable to "/dev/null" or
 ;; whatever is appropriate on your system.
 
+;; For slow remote connections, `tramp-test41-asynchronous-requests'
+;; might be too heavy.  Setting $REMOTE_PARALLEL_PROCESSES to a proper
+;; value less than 10 could help.
+
 ;; A whole test run can be performed calling the command `tramp-test-all'.
 
 ;;; Code:
@@ -4504,8 +4508,13 @@ process sentinels.  They shall not disturb each other."
            (inhibit-message t)
           ;; Do not run delayed timers.
           (timer-max-repeats 0)
-          ;; Number of asynchronous processes for test.
-           (number-proc 10)
+          ;; Number of asynchronous processes for test.  Tests on
+          ;; some machines handle less parallel processes.
+           (number-proc
+            (or
+             (ignore-errors
+               (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES")))
+             10))
            ;; On hydra, timings are bad.
            (timer-repeat
             (cond
@@ -4571,14 +4580,20 @@ process sentinels.  They shall not disturb each other."
                 (set-process-filter
                  proc
                  (lambda (proc string)
+                   (tramp--test-message
+                    "Process filter %s %s %s" proc string 
(current-time-string))
                    (with-current-buffer (process-buffer proc)
                      (insert string))
                    (unless (zerop (length string))
+                    (dired-uncache (process-get proc 'foo))
                      (should (file-attributes (process-get proc 'foo))))))
                 ;; Add process sentinel.
                 (set-process-sentinel
                  proc
                  (lambda (proc _state)
+                   (tramp--test-message
+                    "Process sentinel %s %s" proc (current-time-string))
+                  (dired-uncache (process-get proc 'foo))
                    (should-not (file-attributes (process-get proc 'foo)))))))
 
             ;; Send a string.  Use a random order of the buffers.  Mix
@@ -4594,6 +4609,7 @@ process sentinels.  They shall not disturb each other."
                   (tramp--test-message
                    "Start action %d %s %s" count buf (current-time-string))
                   ;; Regular operation prior process action.
+                 (dired-uncache file)
                   (if (= count 0)
                       (should-not (file-attributes file))
                     (should (file-attributes file)))
@@ -4602,7 +4618,10 @@ process sentinels.  They shall not disturb each other."
                   (accept-process-output proc 0.1 nil 0)
                   ;; Give the watchdog a chance.
                   (read-event nil nil 0.01)
+                  (tramp--test-message
+                   "Continue action %d %s %s" count buf (current-time-string))
                   ;; Regular operation post process action.
+                 (dired-uncache file)
                   (if (= count 2)
                       (should-not (file-attributes file))
                     (should (file-attributes file)))