From a91185211924f65adf7c1376b7f2d710099a5903 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 30 Nov 2023 15:02:37 +0100 Subject: [PATCH] * lisp/net/tramp.el (tramp-signal-process): PROCESS can also be a string. * test/lisp/net/tramp-tests.el (tramp-test31-signal-process): Extend. --- lisp/net/tramp.el | 7 +++ test/lisp/net/tramp-tests.el | 98 +++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 45 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9ca0e3c34d3..854af3e0455 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -6730,7 +6730,14 @@ If PROCESS is a process object which contains the property `remote-pid', or PROCESS is a number and REMOTE is a remote file name, PROCESS is interpreted as process on the respective remote host, which will be the process to signal. +If PROCESS is a string, it is interpreted as process object with +the respective process name, or as a number. SIGCODE may be an integer, or a symbol whose name is a signal name." + (when (stringp process) + (setq process (or (get-process process) + (and (string-match-p (rx bol (+ digit) eol) process) + (string-to-number process)) + (signal 'wrong-type-argument (list #'processp process))))) (let (pid vec) (cond ((processp process) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 726403f193c..58b8530ca2b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5684,55 +5684,63 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-exited-processes t) kill-buffer-query-functions command proc) - (dolist (sigcode '(2 INT)) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test1%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - (should (zerop (signal-process proc sigcode))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + ;; The PROCESS argument of `signal-process' can be a string. Test + ;; this as well. + (dolist + (func '(identity + (lambda (x) (format "%s" (if (processp x) (process-name x) x))))) + (dolist (sigcode '(2 INT)) + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test1-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) + (should + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + (should (zerop (signal-process (funcall func proc) sigcode))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))) - (unwind-protect - (with-temp-buffer - (setq command "trap 'echo boom; exit 1' 2; sleep 100" - proc (start-file-process-shell-command - (format "test2%s" sigcode) (current-buffer) command)) - (should (processp proc)) - (should (process-live-p proc)) - (should (equal (process-status proc) 'run)) - (should (numberp (process-get proc 'remote-pid))) - (should (equal (process-get proc 'remote-command) - (with-connection-local-variables - `(,shell-file-name ,shell-command-switch ,command)))) - ;; `signal-process' has argument REMOTE since Emacs 29. - (with-no-warnings + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test2-%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) (should - (zerop - (signal-process - (process-get proc 'remote-pid) sigcode default-directory)))) - ;; Let the process accept the signal. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc 0 nil t))) - (should-not (process-live-p proc))) + (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + ;; `signal-process' has argument REMOTE since Emacs 29. + (with-no-warnings + (should + (zerop + (signal-process + (funcall func (process-get proc 'remote-pid)) + sigcode default-directory)))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) - ;; Cleanup. - (ignore-errors (kill-process proc)) - (ignore-errors (delete-process proc)))))) + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))))))) (ert-deftest tramp-test31-list-system-processes () "Check `list-system-processes'." -- 2.39.2