Check for successful exit when parsing output with vc-exec-after

When using vc-exec-after to parse program output, check that the
program didn't die to a signal or exit with an error exit code
before attempting the parse.  Continue to use plain
vc-run-delayed where we aren't parsing output, because in these
cases it doesn't matter to CODE if the output is incomplete.

* lisp/vc/vc-dispatcher.el (vc-exec-after): <process-status>:
Treat PROC dying to a signal the same as PROC exiting non-zero.

(vc-exec-after): <accept-process-output>: Restore making a
nonblocking call, for the case of vc-exec-after called from a
process sentinel.  diff-hl *does* require this.

(vc-exec-after): <OKSTATUS>: New parameter, replacing SUCCESS,
which never worked as documented.
* test/lisp/vc/vc-tests/vc-test-misc.el (vc-test-exec-after-3):
Test it.

(vc-run-delayed-success): New macro.
* lisp/vc/vc-git.el (vc-git-dir-status-goto-stage):
* lisp/vc/vc-hg.el (vc-hg-dir-status-files):
* lisp/vc/vc.el (vc-pull-and-push): Use it.

* lisp/obsolete/vc-arch.el (vc-exec-after):
* lisp/obsolete/vc-mtn.el (vc-exec-after):
* lisp/vc/vc-bzr.el (vc-exec-after):
* lisp/vc/vc-cvs.el (vc-exec-after):
* lisp/vc/vc-git.el (vc-exec-after):
* lisp/vc/vc-hg.el (vc-exec-after):
* lisp/vc/vc-svn.el (vc-exec-after): Update declarations.

lisp/obsolete/vc-arch.el

@@ -311,7 +311,7 @@ Only the value `maybe' can be trusted :-(."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 
 (defun vc-arch-dir-status-files (dir _files callback)
   "Run `tla inventory' for DIR and pass results to CALLBACK.
@@ -320,8 +320,9 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
   (let ((default-directory dir))
     (vc-arch-command t 'async nil "changes"))
   ;; The updating could be done asynchronously.
+  ;; FIXME: Consider `vc-run-delayed-success'.
   (vc-run-delayed
-   (vc-arch-after-dir-status callback)))
+    (vc-arch-after-dir-status callback)))
 
 (defun vc-arch-after-dir-status (callback)
   (let* ((state-map '(("M " . edited)

lisp/obsolete/vc-mtn.el

@@ -141,12 +141,13 @@ switches."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 
 (defun vc-mtn-dir-status-files (dir _files update-function)
   (vc-mtn-command (current-buffer) 'async dir "status")
+  ;; FIXME: Consider `vc-run-delayed-success'.
   (vc-run-delayed
-   (vc-mtn-after-dir-status update-function)))
+    (vc-mtn-after-dir-status update-function)))
 
 (defun vc-mtn-working-revision (file)
   ;; If `mtn' fails or returns status>0, or if the search fails, just

lisp/vc/vc-bzr.el

@@ -349,7 +349,7 @@ in the repository root directory of FILE."
   "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
 
 ;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 (declare-function vc-compilation-mode "vc-dispatcher" (backend))
 
@@ -1033,6 +1033,7 @@ stream.  Standard error output is discarded."
 (defun vc-bzr-dir-status-files (dir files update-function)
   "Return a list of conses (file . state) for DIR."
   (apply #'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
+  ;; FIXME: Consider `vc-run-delayed-success'.
   (vc-run-delayed
    (vc-bzr-after-dir-status update-function
                             ;; "bzr status" results are relative to

lisp/vc/vc-cvs.el

@@ -546,7 +546,7 @@ Will fail unless you have administrative privileges on the repo."
 ;;;
 
 ;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 
 (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
   "Print commit log associated with FILES into specified BUFFER.
@@ -1086,6 +1086,7 @@ Query all files in DIR if files is nil."
     (vc-cvs-command (current-buffer) 'async
                     files
                     "-f" "-n" "-q" "update")
+    ;; FIXME: Consider `vc-run-delayed-success'.
     (vc-run-delayed
       (vc-cvs-after-dir-status update-function))))
 

lisp/vc/vc-dispatcher.el

@@ -219,23 +219,38 @@ Another is that undo information is not kept."
                                 'help-echo
                                 "A command is in progress in this buffer"))))
 
-(defun vc-exec-after (code &optional success proc)
+(defun vc-exec-after (code &optional okstatus proc)
   "Execute CODE when PROC, or the current buffer's process, is done.
 CODE should be a function of no arguments.
 CODE a bare form to pass to `eval' is also supported for compatibility.
 
+Optional argument OKSTATUS, if non-nil, is a non-negative integer.
+Run CODE only if PROC (or, if PROC is nil, the current buffer's process)
+exits normally (i.e. does not die to a signal) with exit status not
+exceeding OKSTATUS.
+
+For backwards compatibility, passing PROC (or, if PROC is nil, the
+current buffer's process) as OKSTATUS means the same as OKSTATUS zero.
+Passing other process object is invalid.
+
 The optional PROC argument specifies the process Emacs should wait for
 before executing CODE.  It defaults to the current buffer's process.
 If PROC is nil and the current buffer has no process, just evaluate
-CODE.  Otherwise, add CODE to the process's sentinel.
-
-If SUCCESS, it should be a process object.
-Only run CODE if the SUCCESS process has a zero exit code."
+CODE.  Otherwise, add CODE to the process's sentinel."
   (unless proc (setq proc (get-buffer-process (current-buffer))))
+  ;; For Emacs 29--30 it was documented that the second argument
+  ;; (then named SUCCESS) could be any process, but the implementation
+  ;; was broken for any process other than the current buffer's process.
+  (cond ((eq okstatus proc)
+         (setq okstatus 0))
+        ((and okstatus (not (natnump okstatus)))
+         (error "Invalid OKSTATUS argument to `vc-exec-after': %S"
+                okstatus)))
   (letrec ((eval-code
             (lambda ()
-              (when (or (not success)
-                        (zerop (process-exit-status success)))
+              (when (or (null okstatus) (null proc)
+                        (and (eq (process-status proc) 'exit)
+                             (>= okstatus (process-exit-status proc))))
                 (if (functionp code) (funcall code) (eval code t)))))
            (buf (and proc (process-buffer proc)))
            (fun
@@ -248,7 +263,7 @@ Only run CODE if the SUCCESS process has a zero exit code."
                ;; Selecting deleted buffer".
                ((not (buffer-live-p buf))
                 (remove-function (process-sentinel proc) fun))
-               ((eq (process-status proc) 'exit)
+               ((memq (process-status proc) '(exit signal))
                 (with-current-buffer buf
                   (setq mode-line-process nil)
                   (let (vc-sentinel-movepoint
@@ -279,8 +294,11 @@ Only run CODE if the SUCCESS process has a zero exit code."
      ;; but this led to timing problems causing process output to be
      ;; lost.  Terminated processes get deleted automatically
      ;; anyway. -- cyd
-     ((or (null proc) (eq (process-status proc) 'exit))
-      (when proc (accept-process-output proc))
+     ((or (null proc) (memq (process-status proc) '(exit signal)))
+      (when proc
+        ;; Nonblocking call in case we are ourselves called from a
+        ;; process sentinel (GNU ELPA's diff-hl does this).
+        (accept-process-output proc 0))
       (funcall eval-code))
      ((eq (process-status proc) 'run)
       (when (buffer-live-p buf)
@@ -291,9 +309,19 @@ Only run CODE if the SUCCESS process has a zero exit code."
   nil)
 
 (defmacro vc-run-delayed (&rest body)
+  "Execute BODY when the current buffer's process is done.
+If the current buffer has no process, execute BODY immediately."
   (declare (indent 0) (debug (def-body)))
   `(vc-exec-after (lambda () ,@body)))
 
+(defmacro vc-run-delayed-success (okstatus &rest body)
+  "Execute BODY when the current buffer's process exits successfully.
+This means the current buffer's process exits normally (i.e., does not
+die to a signal) with status not exceeding OKSTATUS.
+If the current buffer has no process, execute BODY immediately."
+  (declare (indent 1) (debug (def-body)))
+  `(vc-exec-after (lambda () ,@body) ,okstatus))
+
 (defun vc-wait-for-process-before-save (proc message)
   "Make Emacs wait for PROC before saving buffers under current VC tree.
 If waiting for PROC takes more than a second, display MESSAGE.

lisp/vc/vc-git.el

@@ -712,7 +712,7 @@ or an empty string if none."
 
 ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
 ;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 ;; Follows vc-exec-after.
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 
@@ -749,7 +749,7 @@ or an empty string if none."
       ('diff-index
        (vc-git-command (current-buffer) 'async files
                        "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
-    (vc-run-delayed
+    (vc-run-delayed-success 1
       (vc-git-after-dir-status-stage git-state))))
 
 (defun vc-git-dir-status-files (_dir files update-function)

lisp/vc/vc-hg.el

@@ -1500,7 +1500,7 @@ REV is the revision to check out into WORKFILE."
 
 ;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
 ;; from vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success proc))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 ;; Follows vc-exec-after.
 (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
 
@@ -1526,7 +1526,7 @@ REV is the revision to check out into WORKFILE."
            (if (version<= "4.2" (vc-hg--program-version))
                '("--config" "commands.status.relative=1")
              '("re:" "-I" "."))))
-  (vc-run-delayed
+  (vc-run-delayed-success 0
     (vc-hg-after-dir-status update-function)))
 
 (defun vc-hg-dir-extra-headers (dir)

lisp/vc/vc-svn.el

@@ -218,7 +218,7 @@ A value of `default' means to use the value of `vc-resolve-conflicts'."
 
 ;; dir-status-files called from vc-dir, which loads vc,
 ;; which loads vc-dispatcher.
-(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
+(declare-function vc-exec-after "vc-dispatcher" (code &optional okstatus proc))
 
 (autoload 'vc-expand-dirs "vc")
 
@@ -228,6 +228,7 @@ CALLBACK is called as (CALLBACK RESULT BUFFER), where
 RESULT is a list of conses (FILE . STATE) for directory DIR."
   ;; FIXME shouldn't this rather default to all the files in dir?
   (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files)
+  ;; FIXME: Consider `vc-run-delayed-success'.
   (vc-run-delayed (vc-svn-after-dir-status callback t)))
 
 (defun vc-svn-dir-extra-headers (_dir)

lisp/vc/vc.el

@@ -4307,18 +4307,12 @@ It also signals an error in a Bazaar bound branch."
   (let* ((vc-fileset (vc-deduce-fileset t))
 	 (backend (car vc-fileset)))
     (if (vc-find-backend-function backend 'pull)
-        (let ((proc (vc-call-backend backend 'pull arg)))
-          (when (and (processp proc) (process-buffer proc))
-            (with-current-buffer (process-buffer proc)
-              (if (and (eq (process-status proc) 'exit)
-                       (zerop (process-exit-status proc)))
-                  (let ((vc--inhibit-async-window t))
-                    (vc-push arg))
-                (vc-exec-after
-                 (lambda ()
-                   (let ((vc--inhibit-async-window t))
-                     (vc-push arg)))
-                 proc)))))
+        (when-let* ((proc (vc-call-backend backend 'pull arg))
+                    (buf (and (processp proc) (process-buffer proc))))
+          (with-current-buffer buf
+            (vc-run-delayed-success 0
+              (let ((vc--inhibit-async-window t))
+                (vc-push arg)))))
       (user-error "VC pull is unsupported for `%s'" backend))))
 
 (defun vc-version-backup-file (file &optional rev)

test/lisp/vc/vc-tests/vc-test-misc.el

@@ -101,26 +101,19 @@
       (should success))))
 
 (ert-deftest vc-test-exec-after-3 ()
-  "Test SUCCESS argument to `vc-exec-after'."
+  "Test OKSTATUS argument to `vc-exec-after'."
   (with-temp-buffer
-    (let ((proc (start-process-shell-command "test" (current-buffer)
-                                             (if (eq system-type 'windows-nt)
-                                                 "sleep 1 & echo hello"
-                                               "sleep 0.2; echo hello")))
-          (passes (start-process "test2" nil "true"))
+    (let ((proc (start-process-shell-command "test" (current-buffer) "true"))
           success)
-      (vc-exec-after (lambda () (setq success t)) passes)
+      (vc-exec-after (lambda () (setq success t)) 0)
       (vc-test--exec-after-wait)
       (should success)))
 
   (with-temp-buffer
-    (let ((proc (start-process-shell-command "test" (current-buffer)
-                                             (if (eq system-type 'windows-nt)
-                                                 "sleep 1 & echo hello"
-                                               "sleep 0.2; echo hello")))
+    (let ((proc (start-process-shell-command "test" (current-buffer) "false"))
           (fails (start-process "test2" nil "false"))
           success)
-      (vc-exec-after (lambda () (setq success t)) fails)
+      (vc-exec-after (lambda () (setq success t)) 0)
       (vc-test--exec-after-wait)
       (should-not success))))