aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2020-01-14 11:46:42 +0100
committerMichael Albinus2020-01-14 11:46:42 +0100
commit06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd (patch)
tree8dd6754d32ae7a56e87abd1967252a387071c231
parent88efc736f562656efab778d35c32d549ef6270d7 (diff)
downloademacs-06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd.tar.gz
emacs-06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd.zip
Refactor Tramp async process code
* lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Update stderr buffer when process has finished. Do not call `auto-revert'. * test/lisp/net/tramp-tests.el (tramp-test31-interrupt-process): Tag it :unstable. Change `accept-process-output' arguments. (tramp--test-async-shell-command): New defun. (tramp--test-shell-command-to-string-asynchronously): Use it. (tramp-test32-shell-command): Refactor code.
-rw-r--r--lisp/net/tramp-adb.el23
-rw-r--r--lisp/net/tramp-sh.el22
-rw-r--r--test/lisp/net/tramp-tests.el146
3 files changed, 82 insertions, 109 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 0e4ac536d3a..efe89344216 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -935,6 +935,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
935;; We use BUFFER also as connection buffer during setup. Because of 935;; We use BUFFER also as connection buffer during setup. Because of
936;; this, its original contents must be saved, and restored once 936;; this, its original contents must be saved, and restored once
937;; connection has been setup. 937;; connection has been setup.
938;; The complete STDERR buffer is available only when the process has
939;; terminated.
938(defun tramp-adb-handle-make-process (&rest args) 940(defun tramp-adb-handle-make-process (&rest args)
939 "Like `make-process' for Tramp files." 941 "Like `make-process' for Tramp files."
940 (when args 942 (when args
@@ -983,6 +985,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
983 (if (and (stringp stderr) (tramp-tramp-file-p stderr)) 985 (if (and (stringp stderr) (tramp-tramp-file-p stderr))
984 (tramp-unquote-file-local-name stderr) 986 (tramp-unquote-file-local-name stderr)
985 (tramp-make-tramp-temp-file v)))) 987 (tramp-make-tramp-temp-file v))))
988 (remote-tmpstderr
989 (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
986 (program (car command)) 990 (program (car command))
987 (args (cdr command)) 991 (args (cdr command))
988 (command 992 (command
@@ -1049,9 +1053,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
1049 (add-function 1053 (add-function
1050 :after (process-sentinel p) 1054 :after (process-sentinel p)
1051 (lambda (_proc _msg) 1055 (lambda (_proc _msg)
1052 (rename-file 1056 (rename-file remote-tmpstderr stderr))))
1053 (tramp-make-tramp-file-name v tmpstderr)
1054 stderr))))
1055 ;; Read initial output. Remove the first line, 1057 ;; Read initial output. Remove the first line,
1056 ;; which is the command echo. 1058 ;; which is the command echo.
1057 (while 1059 (while
@@ -1062,20 +1064,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
1062 (delete-region (point-min) (point)) 1064 (delete-region (point-min) (point))
1063 ;; Provide error buffer. This shows only 1065 ;; Provide error buffer. This shows only
1064 ;; initial error messages; messages arriving 1066 ;; initial error messages; messages arriving
1065 ;; later on shall be inserted by 1067 ;; later on will be inserted when the process
1066 ;; `auto-revert'. The temporary file will 1068 ;; is deleted. The temporary file will exist
1067 ;; exist until the process is deleted. 1069 ;; until the process is deleted.
1068 (when (bufferp stderr) 1070 (when (bufferp stderr)
1069 (with-current-buffer stderr 1071 (with-current-buffer stderr
1070 (insert-file-contents 1072 (insert-file-contents remote-tmpstderr 'visit))
1071 (tramp-make-tramp-file-name v tmpstderr) 'visit)
1072 (auto-revert-mode))
1073 ;; Delete tmpstderr file. 1073 ;; Delete tmpstderr file.
1074 (add-function 1074 (add-function
1075 :after (process-sentinel p) 1075 :after (process-sentinel p)
1076 (lambda (_proc _msg) 1076 (lambda (_proc _msg)
1077 (delete-file 1077 (with-current-buffer stderr
1078 (tramp-make-tramp-file-name v tmpstderr))))) 1078 (insert-file-contents remote-tmpstderr 'visit))
1079 (delete-file remote-tmpstderr))))
1079 ;; Return process. 1080 ;; Return process.
1080 p)))) 1081 p))))
1081 1082
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6e5b9d243fb..4ca1f651734 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2806,6 +2806,8 @@ the result will be a local, non-Tramp, file name."
2806;; We use BUFFER also as connection buffer during setup. Because of 2806;; We use BUFFER also as connection buffer during setup. Because of
2807;; this, its original contents must be saved, and restored once 2807;; this, its original contents must be saved, and restored once
2808;; connection has been setup. 2808;; connection has been setup.
2809;; The complete STDERR buffer is available only when the process has
2810;; terminated.
2809(defun tramp-sh-handle-make-process (&rest args) 2811(defun tramp-sh-handle-make-process (&rest args)
2810 "Like `make-process' for Tramp files. 2812 "Like `make-process' for Tramp files.
2811STDERR can also be a file name." 2813STDERR can also be a file name."
@@ -2855,6 +2857,8 @@ STDERR can also be a file name."
2855 (if (and (stringp stderr) (tramp-tramp-file-p stderr)) 2857 (if (and (stringp stderr) (tramp-tramp-file-p stderr))
2856 (tramp-unquote-file-local-name stderr) 2858 (tramp-unquote-file-local-name stderr)
2857 (tramp-make-tramp-temp-file v)))) 2859 (tramp-make-tramp-temp-file v))))
2860 (remote-tmpstderr
2861 (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
2858 (program (car command)) 2862 (program (car command))
2859 (args (cdr command)) 2863 (args (cdr command))
2860 ;; When PROGRAM matches "*sh", and the first arg is 2864 ;; When PROGRAM matches "*sh", and the first arg is
@@ -2994,24 +2998,22 @@ STDERR can also be a file name."
2994 (add-function 2998 (add-function
2995 :after (process-sentinel p) 2999 :after (process-sentinel p)
2996 (lambda (_proc _msg) 3000 (lambda (_proc _msg)
2997 (rename-file 3001 (rename-file remote-tmpstderr stderr))))
2998 (tramp-make-tramp-file-name v tmpstderr) stderr))))
2999 ;; Provide error buffer. This shows only 3002 ;; Provide error buffer. This shows only
3000 ;; initial error messages; messages arriving 3003 ;; initial error messages; messages arriving
3001 ;; later on shall be inserted by `auto-revert'. 3004 ;; later on will be inserted when the process is
3002 ;; The temporary file will exist until the 3005 ;; deleted. The temporary file will exist until
3003 ;; process is deleted. 3006 ;; the process is deleted.
3004 (when (bufferp stderr) 3007 (when (bufferp stderr)
3005 (with-current-buffer stderr 3008 (with-current-buffer stderr
3006 (insert-file-contents 3009 (insert-file-contents remote-tmpstderr 'visit))
3007 (tramp-make-tramp-file-name v tmpstderr) 'visit)
3008 (auto-revert-mode))
3009 ;; Delete tmpstderr file. 3010 ;; Delete tmpstderr file.
3010 (add-function 3011 (add-function
3011 :after (process-sentinel p) 3012 :after (process-sentinel p)
3012 (lambda (_proc _msg) 3013 (lambda (_proc _msg)
3013 (delete-file 3014 (with-current-buffer stderr
3014 (tramp-make-tramp-file-name v tmpstderr))))) 3015 (insert-file-contents remote-tmpstderr 'visit))
3016 (delete-file remote-tmpstderr))))
3015 ;; Return process. 3017 ;; Return process.
3016 p))) 3018 p)))
3017 3019
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e2d7e35b52f..549fb70aa92 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4403,7 +4403,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4403 4403
4404(ert-deftest tramp-test31-interrupt-process () 4404(ert-deftest tramp-test31-interrupt-process ()
4405 "Check `interrupt-process'." 4405 "Check `interrupt-process'."
4406 :tags '(:expensive-test) 4406 ;; The test fails from time to time, w/o a reproducible pattern. So
4407 ;; we mark it as unstable.
4408 :tags '(:expensive-test :unstable)
4407 (skip-unless (tramp--test-enabled)) 4409 (skip-unless (tramp--test-enabled))
4408 (skip-unless (tramp--test-sh-p)) 4410 (skip-unless (tramp--test-sh-p))
4409 ;; Since Emacs 26.1. 4411 ;; Since Emacs 26.1.
@@ -4424,7 +4426,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4424 (should (interrupt-process proc)) 4426 (should (interrupt-process proc))
4425 ;; Let the process accept the interrupt. 4427 ;; Let the process accept the interrupt.
4426 (with-timeout (10 (tramp--test-timeout-handler)) 4428 (with-timeout (10 (tramp--test-timeout-handler))
4427 (while (accept-process-output proc nil nil 0))) 4429 (while (process-live-p proc)
4430 (while (accept-process-output proc 0 nil t))))
4428 (should-not (process-live-p proc)) 4431 (should-not (process-live-p proc))
4429 ;; An interrupted process cannot be interrupted, again. 4432 ;; An interrupted process cannot be interrupted, again.
4430 (should-error 4433 (should-error
@@ -4434,14 +4437,27 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4434 ;; Cleanup. 4437 ;; Cleanup.
4435 (ignore-errors (delete-process proc))))) 4438 (ignore-errors (delete-process proc)))))
4436 4439
4440(defun tramp--test-async-shell-command
4441 (command output-buffer &optional error-buffer input)
4442 "Like `async-shell-command', reading the output.
4443INPUT, if non-nil, is a string sent to the process."
4444 (let ((proc (async-shell-command command output-buffer error-buffer)))
4445 (when (stringp input)
4446 (process-send-string proc input))
4447 (with-timeout
4448 ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
4449 (while (accept-process-output proc nil nil t))
4450 (should-not (process-live-p proc)))
4451 ;; `ls' could produce colorized output.
4452 (with-current-buffer output-buffer
4453 (goto-char (point-min))
4454 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
4455 (replace-match "" nil nil)))))
4456
4437(defun tramp--test-shell-command-to-string-asynchronously (command) 4457(defun tramp--test-shell-command-to-string-asynchronously (command)
4438 "Like `shell-command-to-string', but for asynchronous processes." 4458 "Like `shell-command-to-string', but for asynchronous processes."
4439 (with-temp-buffer 4459 (with-temp-buffer
4440 (async-shell-command command (current-buffer)) 4460 (tramp--test-async-shell-command command (current-buffer))
4441 (with-timeout
4442 ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
4443 (while (accept-process-output
4444 (get-buffer-process (current-buffer)) nil nil t)))
4445 (buffer-substring-no-properties (point-min) (point-max)))) 4461 (buffer-substring-no-properties (point-min) (point-max))))
4446 4462
4447(ert-deftest tramp-test32-shell-command () 4463(ert-deftest tramp-test32-shell-command ()
@@ -4460,101 +4476,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4460 (inhibit-message t) 4476 (inhibit-message t)
4461 kill-buffer-query-functions) 4477 kill-buffer-query-functions)
4462 4478
4463 ;; Test ordinary `shell-command'. 4479 (dolist (this-shell-command
4464 (unwind-protect 4480 '(;; Synchronously.
4465 (with-temp-buffer 4481 shell-command
4466 (write-region "foo" nil tmp-name) 4482 ;; Asynchronously.
4467 (should (file-exists-p tmp-name)) 4483 tramp--test-async-shell-command))
4468 (shell-command
4469 (format "ls %s" (file-name-nondirectory tmp-name))
4470 (current-buffer))
4471 ;; `ls' could produce colorized output.
4472 (goto-char (point-min))
4473 (while
4474 (re-search-forward tramp-display-escape-sequence-regexp nil t)
4475 (replace-match "" nil nil))
4476 (should
4477 (string-equal
4478 (format "%s\n" (file-name-nondirectory tmp-name))
4479 (buffer-string))))
4480
4481 ;; Cleanup.
4482 (ignore-errors (delete-file tmp-name)))
4483 4484
4484 ;; Test `shell-command' with error buffer. 4485 ;; Test ordinary `{async-}shell-command'.
4485 (let ((stderr (generate-new-buffer "*stderr*")))
4486 (unwind-protect 4486 (unwind-protect
4487 (with-temp-buffer 4487 (with-temp-buffer
4488 (shell-command "cat /" (current-buffer) stderr) 4488 (write-region "foo" nil tmp-name)
4489 (should (= (point-min) (point-max))) 4489 (should (file-exists-p tmp-name))
4490 (with-current-buffer stderr 4490 (funcall
4491 (should 4491 this-shell-command
4492 (string-match "cat:.* Is a directory" (buffer-string))))) 4492 (format "ls %s" (file-name-nondirectory tmp-name))
4493 (current-buffer))
4494 (should
4495 (string-equal
4496 (format "%s\n" (file-name-nondirectory tmp-name))
4497 (buffer-string))))
4493 4498
4494 ;; Cleanup. 4499 ;; Cleanup.
4495 (ignore-errors (kill-buffer stderr)))) 4500 (ignore-errors (delete-file tmp-name)))
4496
4497 ;; Test ordinary `async-shell-command'.
4498 (unwind-protect
4499 (with-temp-buffer
4500 (write-region "foo" nil tmp-name)
4501 (should (file-exists-p tmp-name))
4502 (async-shell-command
4503 (format "ls %s" (file-name-nondirectory tmp-name))
4504 (current-buffer))
4505 ;; Read output.
4506 (with-timeout (10 (tramp--test-timeout-handler))
4507 (while (accept-process-output
4508 (get-buffer-process (current-buffer)) nil nil t)))
4509 ;; `ls' could produce colorized output.
4510 (goto-char (point-min))
4511 (while
4512 (re-search-forward tramp-display-escape-sequence-regexp nil t)
4513 (replace-match "" nil nil))
4514 (should
4515 (string-equal
4516 (format "%s\n" (file-name-nondirectory tmp-name))
4517 (buffer-string))))
4518
4519 ;; Cleanup.
4520 (ignore-errors (delete-file tmp-name)))
4521 4501
4522 ;; Test `async-shell-command' with error buffer. 4502 ;; Test `{async-}shell-command' with error buffer.
4523 (let ((stderr (generate-new-buffer "*stderr*")) proc) 4503 (let ((stderr (generate-new-buffer "*stderr*")))
4524 (unwind-protect 4504 (unwind-protect
4525 (with-temp-buffer 4505 (with-temp-buffer
4526 (async-shell-command "cat /; sleep 1" (current-buffer) stderr) 4506 (funcall
4527 (setq proc (get-buffer-process (current-buffer))) 4507 this-shell-command "cat /; sleep 1" (current-buffer) stderr)
4528 ;; Read stderr. 4508 ;; Check stderr.
4529 (when (processp proc) 4509 (when (eq this-shell-command #'tramp--test-async-shell-command)
4530 (with-timeout (10 (tramp--test-timeout-handler)) 4510 (ignore-errors
4531 (while (accept-process-output proc nil nil t))) 4511 (delete-process (get-buffer-process (current-buffer)))))
4532 (delete-process proc)) 4512 (should (zerop (buffer-size)))
4533 (with-current-buffer stderr 4513 (with-current-buffer stderr
4534 (should 4514 (should
4535 (string-match "cat:.* Is a directory" (buffer-string))))) 4515 (string-match "cat:.* Is a directory" (buffer-string)))))
4536 4516
4537 ;; Cleanup. 4517 ;; Cleanup.
4538 (ignore-errors (kill-buffer stderr)))) 4518 (ignore-errors (kill-buffer stderr)))))
4539 4519
4540 ;; Test sending string to `async-shell-command'. 4520 ;; Test sending string to `async-shell-command'.
4541 (unwind-protect 4521 (unwind-protect
4542 (with-temp-buffer 4522 (with-temp-buffer
4543 (write-region "foo" nil tmp-name) 4523 (write-region "foo" nil tmp-name)
4544 (should (file-exists-p tmp-name)) 4524 (should (file-exists-p tmp-name))
4545 (async-shell-command "read line; ls $line" (current-buffer)) 4525 (tramp--test-async-shell-command
4546 (process-send-string 4526 "read line; ls $line" (current-buffer) nil
4547 (get-buffer-process (current-buffer))
4548 (format "%s\n" (file-name-nondirectory tmp-name))) 4527 (format "%s\n" (file-name-nondirectory tmp-name)))
4549 ;; Read output.
4550 (with-timeout (10 (tramp--test-timeout-handler))
4551 (while (accept-process-output
4552 (get-buffer-process (current-buffer)) nil nil t)))
4553 ;; `ls' could produce colorized output.
4554 (goto-char (point-min))
4555 (while
4556 (re-search-forward tramp-display-escape-sequence-regexp nil t)
4557 (replace-match "" nil nil))
4558 (should 4528 (should
4559 (string-equal 4529 (string-equal
4560 ;; tramp-adb.el echoes, so we must add the string. 4530 ;; tramp-adb.el echoes, so we must add the string.
@@ -6239,7 +6209,7 @@ If INTERACTIVE is non-nil, the tests are run interactively."
6239;; do not work properly for `nextcloud'. 6209;; do not work properly for `nextcloud'.
6240;; * Fix `tramp-test29-start-file-process' and 6210;; * Fix `tramp-test29-start-file-process' and
6241;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). 6211;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
6242;; * Implement `tramp-test31-interrupt-process' for `adb'. 6212;; * Implement `tramp-test31-interrupt-process' for `adb'. Fix `:unstable'.
6243;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote 6213;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
6244;; file name operation cannot run in the timer. Remove `:unstable' tag? 6214;; file name operation cannot run in the timer. Remove `:unstable' tag?
6245 6215