diff options
| author | Michael Albinus | 2020-01-14 11:46:42 +0100 |
|---|---|---|
| committer | Michael Albinus | 2020-01-14 11:46:42 +0100 |
| commit | 06caa3b7e5e9fe91b6918f8567adbd5501d6dbdd (patch) | |
| tree | 8dd6754d32ae7a56e87abd1967252a387071c231 | |
| parent | 88efc736f562656efab778d35c32d549ef6270d7 (diff) | |
| download | emacs-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.el | 23 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 22 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 146 |
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. |
| 2811 | STDERR can also be a file name." | 2813 | STDERR 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. | ||
| 4443 | INPUT, 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 | ||