Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

* lisp/net/tramp.el (tramp-signal-process): PROCESS can also be a string.

Browse source 
* test/lisp/net/tramp-tests.el (tramp-test31-signal-process): Extend.
This commit is contained in:
Michael Albinus 2023-11-30 15:02:37 +01:00
parent 5aba199d75
commit a911852119
2 changed files with 62 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/net/tramp.el
View file

@ -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)

102
test/lisp/net/tramp-tests.el
View file

@ -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)))
;; 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
;; 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
(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))))
(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
(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)))))))
(ert-deftest tramp-test31-list-system-processes ()
"Check `list-system-processes'."