common, fix: use a different way to see if an async process is finished

Fix #150, #163.

citre-common-util.el

@@ -386,8 +386,8 @@ NAME is the name of the process.  When it's nil, the first
 element in CMD is used as the name.  The name may be uniquified.
 
 CALLBACK is called when the output of the process is received, or
-when the status of it changed.  It receives 2 arguments: STATUS
-and MSG.  STATUS can be:
+when the status of it changed.  It receives 3 arguments: PROC,
+STATUS and MSG.  PROC is the process.  STATUS can be:
 
 - output: We've received a chunk from stdout of the process.  MSG
   is this chunk, and is guaranteed to end in a newline char.
@@ -420,7 +420,7 @@ for your callback function."
            :stderr stderr-buffer
            :file-handler t
            :filter
-           (lambda (_proc str)
+           (lambda (proc str)
              (let* ((chunk-end
                      ;; Find last newline char.
                      (pcase (string-match (rx "\n" (* (not (any "\n")))
@@ -433,8 +433,9 @@ for your callback function."
                  (if chunk-end
                      (progn
                        (funcall (citre-process-callback proc-data)
-                                'output (concat stdout-cache
-                                                (substring str 0 chunk-end)))
+                                proc 'output
+                                (concat stdout-cache
+                                        (substring str 0 chunk-end)))
                        (setf stdout-cache (substring str chunk-end)))
                    (setf stdout-cache (concat stdout-cache str))))))
            :sentinel
@@ -445,13 +446,13 @@ for your callback function."
                    (pcase (process-status proc)
                      ('exit
                       (pcase (process-exit-status proc)
-                        (0 (funcall callback 0 nil))
+                        (0 (funcall callback proc 0 nil))
                         (s (if (buffer-live-p stderr-buffer)
-                               (funcall callback s
+                               (funcall callback proc s
                                         (with-current-buffer stderr-buffer
                                           (buffer-string)))
                              ""))))
-                     (s (funcall callback s nil)))
+                     (s (funcall callback proc s nil)))
                  (when (buffer-live-p stderr-buffer)
                    (citre-kill-process-buffer stderr-buffer))))))))
     (setf (citre-process-proc proc-data) proc)
@@ -479,22 +480,20 @@ process exits abnormally or run into abnormal status, an error is
 signaled."
   (let* ((result nil)
          (err-msg nil)
-         (finished nil)
-         (success nil)
          (callback
-          (lambda (status msg)
+          (lambda (proc status msg)
             (pcase status
               ('output (setq result
                              (nconc result (split-string msg "\n" t))))
-              (0 (setq success t))
+              (0 (process-put proc 'citre-finish-status 'success))
               ((and s (pred integerp))
+               (process-put proc 'citre-finish-status 'fail)
                (setq err-msg (format "Process %s exits %s:\n%s"
                                      (car cmd) s msg)))
-              ('signal nil)
-              (s (setq err-msg (format "Abnormal status of process %s:\n%s"
-                                       (car cmd) s))))
-            (unless (eq status 'output)
-              (setq finished t))))
+              ('signal (process-put proc 'citre-finish-status 'fail))
+              (s (process-put proc 'citre-finish-status 'fail)
+                 (setq err-msg (format "Abnormal status of process %s:\n%s"
+                                       (car cmd) s))))))
          (proc-data (citre-make-async-process cmd callback))
          (proc (citre-process-proc proc-data)))
     (unwind-protect
@@ -522,20 +521,20 @@ signaled."
           ;; Wait for the process to finish.  This trick is borrowed from
           ;; emacs-aio (/~https://github.com/skeeto/emacs-aio).  This doesn't
           ;; block.
-          (while (not finished) (accept-process-output))
+          (while (null (process-get proc 'citre-finish-status))
+            (accept-process-output))
           ;; The process is finished, but there may still be buffered output
           ;; that's pending, so we `accept-process-output' from the process,
           ;; and the related stderr pipe process.  This blocks, but doesn't
           ;; cause a problem, as the process is finished, and the remaining
           ;; data should be consumed rather quickly.  No need to wait for the
           ;; stderr pipe process as the error message is already set when the
           ;; process exits, and in practice this lags popup completion.
-          (when success
-            (while (accept-process-output proc)))
-          (cond
-           (success result)
-           (err-msg (error err-msg))
-           (t nil)))
+          (pcase (process-get proc 'citre-finish-status)
+            ('success (accept-process-output proc))
+            ('fail (error err-msg))
+            (s (error "Invalid FINISH-STATUS %s" s)))
+          result)
       (citre-destruct-process proc-data))))
 
 (provide 'citre-common-util)

tests/common-process/test.el

@@ -18,7 +18,7 @@
   "Test output handling of async processes."
   (let* ((success nil)
          (output "")
-         (callback (lambda (status msg)
+         (callback (lambda (_proc status msg)
                      (pcase status
                        ('output (setq output (concat output msg)))
                        (0 nil)
@@ -32,7 +32,7 @@
 (ert-deftest test-async-process-exit-0 ()
   "Test handling of exit status 0 of async processes."
   (let* ((success nil)
-         (callback (lambda (status msg)
+         (callback (lambda (_proc status msg)
                      (pcase status
                        ('output nil)
                        (0 (should (equal msg nil)))
@@ -45,7 +45,7 @@
 (ert-deftest test-async-process-exit-1 ()
   "Test handling of exit status 0 of async processes."
   (let* ((success nil)
-         (callback (lambda (status msg)
+         (callback (lambda (_proc status msg)
                      (pcase status
                        ('output nil)
                        ;; I think this may fail when there's large chunks of
@@ -60,7 +60,7 @@
 (ert-deftest test-async-process-signal ()
   "Test signal handling of async processes."
   (let* ((success nil)
-         (callback (lambda (status msg)
+         (callback (lambda (_proc status msg)
                      (should (eq status 'signal))))
          (proc-data (citre-make-async-process '("sh" "-c" "sleep 1")
                                               callback)))