From bb1938237ee85e477243cd45421330403df29390 Mon Sep 17 00:00:00 2001 From: Paul Pogonyshev Date: Sun, 9 Jun 2024 14:11:50 +0200 Subject: [PATCH] Revert the last commit as it apparently causes freezes; even often enough that more than one CI runs got stuck. This reverts commit d282e11d68274f8e81b3e56071fc62e6530b80b0. --- eldev-util.el | 23 +++++++++++++---------- test/functions.el | 3 +++ 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/eldev-util.el b/eldev-util.el index 5e86f41..9afedd3 100644 --- a/eldev-util.el +++ b/eldev-util.el @@ -1842,19 +1842,17 @@ Since 1.2: (when (and (eq forward-output 'stderr) (null stderr-buffer)) (setf stderr-buffer (generate-new-buffer " *stderr*"))) (unwind-protect - (let ((main-process-live t) - stderr-process-live) + (progn ;; When forwarding only stdout, we create a dummy pipe for stderr ;; only to discard it. (setf stderr-pipe (when (or stderr-buffer (eq forward-output 'stdout)) - (setf stderr-process-live t) (make-pipe-process :name (format "%s stderr" executable) :buffer stderr-buffer :filter (when (eq forward-output 'stderr) (lambda (process string) (eldev--do-stderr-output string) (internal-default-process-filter process string))) - :sentinel (lambda (process &rest _) (setf stderr-process-live (process-live-p process))) + :sentinel #'ignore :noquery t)) process (make-process :name executable :command `(,executable ,@command-line) @@ -1864,18 +1862,16 @@ Since 1.2: (princ string) (internal-default-process-filter process string))) :stderr stderr-pipe - :sentinel (lambda (process &rest _) (setf main-process-live (process-live-p process))) + ;; Default would write some useless message. + :sentinel #'ignore :noquery t)) (when infile (with-temp-buffer (insert-file-contents-literally infile) (process-send-string process (buffer-string)))) (unless dont-wait - ;; It seems important to check on variables updated from process sentinels rather - ;; than just calling `process-live-p' here. Otherwise in rare circumstances we'd - ;; lose some last chunk(s) of process output, see test `eldev-call-process-4'. - (while (let ((wait-on (cond (main-process-live process) - (stderr-process-live stderr-pipe)))) + (while (let ((wait-on (cond ((process-live-p process) process) + ((process-live-p stderr-pipe) stderr-pipe)))) (when wait-on ;; Having nil for the timeout would make the function return right away ;; rather than wait "forever". In principle, I'd replace the timeout @@ -1884,6 +1880,13 @@ Since 1.2: ;; is important for making it return quickly if the process dies. (accept-process-output wait-on 1.0) t))) + ;; Emacs (or maybe this is not Emacs-specific, not sure) can declare processes + ;; finished even if there is still some not-yet-accepted output, which we'd lose + ;; without the following loop (see test `eldev-call-process-4'). However, the + ;; preceding loop is still important to have, as the following never waits (process + ;; is dead by now, cannot generate yet more), whereas the previous loop runs for as + ;; long as the process is alive. + (while (accept-process-output)) (process-exit-status process))) (when (buffer-live-p stdout-buffer) (with-current-buffer stdout-buffer diff --git a/test/functions.el b/test/functions.el index 4ab5050..df15c6b 100644 --- a/test/functions.el +++ b/test/functions.el @@ -92,6 +92,9 @@ ;; It seems there was/is a race condition due to which process output could be sometimes ;; missing. Try to trigger this bug if still present with some "stress-testing". (ert-deftest eldev-call-process-4 () + ;; The bug is still there on macOS, but I don't know how to debug it... + (when (eq system-type 'darwin) + (ert-skip "Known to sometimes result in bugs on macOS...")) ;; Seems to be terribly slow on Windows (maybe it's GitHub CI machines, don't know). (let ((num-loops (if (eq system-type 'windows-nt) 100 1000))) (dotimes (k num-loops)