kill-process doesn't kill process

Question

Why does the following sexp hang?

(let ((buf
          "*Async Shell Command*"))
     (async-shell-command "cat")
     (while (get-buffer-process buf)
       (message "still has proc")
       (kill-process (get-buffer-process buf))))

Answer 1

Another attempt at explaining the situation:

(let ((buf "*Async Shell Command*"))
  (async-shell-command "cat")
  (while (let ((bp (get-buffer-process buf)))
           (message "status: %s" (process-status bp))
           bp)
    (message "still has proc")
    (kill-process (get-buffer-process buf))
    (accept-process-output)
    (message "Letting emacs to deal with closing a process")))

Then switch to the *Messages* buffer and look at the output, you should see:

status: run
still has proc
Letting emacs to deal with closing a process
status: signal
still has proc
cat: killed.
Letting emacs to deal with closing a process
Entering debugger...

What I believe is happening:

When Emacs starts a process, it sets its hooks for processing its events. A hook dealing with event related to killing the process needs to run in the same thread in which your while loop is executing, but, unless while yields (it may sleep for example), Emacs will not be able to execute the hook. So it will appear as if the process is still there. This is very similar to the typical problems in cooperative multitasking schemes, where processes must make room for other processes to run, or otherwise some processes will never get the possibility to execute.

Answer 2

kill-process is working in your case. But for a reason get-buffer-process does not return nil to while. Maybe because it refers to a buffer which is not yet closed, and emacs needs to take a breath? A sit-for command will fix this.

A solution would be:

(let ((buf
       "*Async Shell Command*"))
  (async-shell-command "cat")
  (while (get-buffer-process buf)
    (message "still has proc")
    (kill-process (get-buffer-process buf))
    (sit-for 0.01)))

Another solution could be not to use get-buffer-process:

(let ((buf
          "*Async Shell Command*"))
     (async-shell-command "cat")
     (while (not (string= (kill-process buf) buf))
       (message "still has proc")))