Skip to content

Commit

Permalink
Revert the last commit as it apparently causes freezes; even often en…
Browse files Browse the repository at this point in the history 
…ough that more than one CI runs got stuck.

This reverts commit d282e11.
  • Loading branch information
@doublep
doublep committed Jun 9, 2024
1 parent d282e11 commit bb19382
Show file tree
Hide file tree
Showing 2 changed files with 16 additions and 10 deletions.
23 changes: 13 additions & 10 deletions eldev-util.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand Down
3 changes: 3 additions & 0 deletions test/functions.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit bb19382

Please sign in to comment.