From: Michael Albinus <michael.albinus@gmx.de>
Date: Wed, 5 Jul 2017 15:03:42 +0000 (+0200)
Subject: Suppress timers in Tramp
X-Git-Tag: emacs-26.0.90~520^2~9
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=17efc48000b8cb46c795742b40799ba1bb2019bc;p=emacs.git

Suppress timers in Tramp

* lisp/net/tramp.el (tramp-file-name-handler): Don't trigger timers.

* test/lisp/net/tramp-tests.el
(tramp-test36-asynchronous-requests): Trigger timers.
(tramp-test37-recursive-load, tramp-test38-remote-load-path):
Set `default-directory' to a trustworthy value.
---

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9c327c410a7..945f81188c8 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2128,9 +2128,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
 				  (unwind-protect
 				      (let ((tramp-locker t))
 					(apply foreign operation args))
-				    ;; Give timers a chance.
-				    (unless (setq tramp-locked tl)
-				      (sit-for 0.001 'nodisp)))))))
+				    (setq tramp-locked tl))))))
 		      (cond
 		       ((eq result 'non-essential)
 			(tramp-message
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 31cf7f9ba1c..6c02daa6547 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3739,6 +3739,8 @@ process sentinels.  They shall not disturb each other."
 
             ;; Open asynchronous processes.  Set process filter and sentinel.
             (dolist (buf buffers)
+	      ;; Activate timer.
+	      (sit-for 0.01 'nodisp)
               (let ((proc
                      (start-file-process-shell-command
                       (buffer-name buf) buf
@@ -3768,6 +3770,8 @@ process sentinels.  They shall not disturb each other."
             ;; with regular operation.
             (let ((buffers (copy-sequence buffers)))
               (while buffers
+		;; Activate timer.
+		(sit-for 0.01 'nodisp)
                 (let* ((buf (nth (random (length buffers)) buffers))
                        (proc (get-buffer-process buf))
                        (file (process-get proc 'foo))
@@ -3808,31 +3812,34 @@ process sentinels.  They shall not disturb each other."
   "Check that Tramp does not fail due to recursive load."
   (skip-unless (tramp--test-enabled))
 
-  (dolist (code
-	   (list
-	    (format "(expand-file-name %S)" tramp-test-temporary-file-directory)
-	    (format
-	     "(let ((default-directory %S)) (expand-file-name %S))"
-	     tramp-test-temporary-file-directory
-	     temporary-file-directory)))
-    (should-not
-     (string-match
-      "Recursive load"
-      (shell-command-to-string
-       (format
-	"%s -batch -Q -L %s --eval %s"
-	(expand-file-name invocation-name invocation-directory)
-	(mapconcat 'shell-quote-argument load-path " -L ")
-	(shell-quote-argument code)))))))
+  (let ((default-directory (expand-file-name temporary-file-directory)))
+    (dolist (code
+	     (list
+	      (format
+	       "(expand-file-name %S)" tramp-test-temporary-file-directory)
+	      (format
+	       "(let ((default-directory %S)) (expand-file-name %S))"
+	       tramp-test-temporary-file-directory
+	       temporary-file-directory)))
+      (should-not
+       (string-match
+	"Recursive load"
+	(shell-command-to-string
+	 (format
+	  "%s -batch -Q -L %s --eval %s"
+	  (expand-file-name invocation-name invocation-directory)
+	  (mapconcat 'shell-quote-argument load-path " -L ")
+	  (shell-quote-argument code))))))))
 
 (ert-deftest tramp-test38-remote-load-path ()
   "Check that Tramp autoloads its packages with remote `load-path'."
   ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
   ;; It shall still work, when a remote file name is in the
   ;; `load-path'.
-  (let ((code
-	 "(let ((force-load-messages t)\
-		(load-path (cons \"/foo:bar:\" load-path)))\
+  (let ((default-directory (expand-file-name temporary-file-directory))
+	(code
+	 "(let ((force-load-messages t) \
+		(load-path (cons \"/foo:bar:\" load-path))) \
 	    (tramp-cleanup-all-connections))"))
     (should
      (string-match