From 5d115029a52d2b64f22af32e2016ab6420d0bcac Mon Sep 17 00:00:00 2001 From: takeokunn Date: Wed, 30 Sep 2026 00:05:09 +0900 Subject: [PATCH] fix: reap completed background jobs before reading status --- src/infrastructure/acl/signal-acl.lisp | 7 ++++- src/presentation/repl-process.lisp | 5 ++++ t/integration/test-signal-handling.lisp | 9 ++++-- t/unit/test-repl-background.lisp | 40 +++++++++++++++++++++++++ 4 files changed, 58 insertions(+), 3 deletions(-) diff --git a/src/infrastructure/acl/signal-acl.lisp b/src/infrastructure/acl/signal-acl.lisp index ae0da931..afa244b0 100644 --- a/src/infrastructure/acl/signal-acl.lisp +++ b/src/infrastructure/acl/signal-acl.lisp @@ -115,9 +115,14 @@ (sb-sys:enable-interrupt sb-unix:sigtstp :default) (kill-process (current-process-id) sb-unix:sigtstp))) +(defun %refresh-sbcl-process-statuses () + "Let SBCL update process objects before notifying the shell job monitor." + (sb-impl::get-processes-status-changes)) + (defun shell-sigchld-handler (signal info context) - "Record that child process state changed; reaping is done outside the handler." + "Refresh SBCL process objects and record that child state changed." (declare (ignore signal info context)) + (%refresh-sbcl-process-statuses) (setf *children-changed* t)) (defun shell-sigwinch-handler (signal info context) diff --git a/src/presentation/repl-process.lisp b/src/presentation/repl-process.lisp index 30180a93..4f6ae569 100644 --- a/src/presentation/repl-process.lisp +++ b/src/presentation/repl-process.lisp @@ -8,6 +8,10 @@ #'nshell.infrastructure.acl:process-exit-status-code "Function used to read the shell-compatible exit code from a completed background process.") +(defparameter *background-proc-wait* + #'nshell.infrastructure.acl:process-wait + "Function used to collect a completed background process.") + (defun reap-background-jobs () ;; The registry scan remains authoritative; this only acknowledges signal delivery. (nshell.infrastructure.acl:consume-children-changed-p) @@ -27,6 +31,7 @@ jid)) (statuses (mapcar (lambda (proc) + (funcall *background-proc-wait* proc) (or (funcall *background-proc-exit-code* proc) 0)) procs))) (nshell.domain.job-control:complete-job diff --git a/t/integration/test-signal-handling.lisp b/t/integration/test-signal-handling.lisp index 8da72ab5..0537c1d7 100644 --- a/t/integration/test-signal-handling.lisp +++ b/t/integration/test-signal-handling.lisp @@ -77,8 +77,13 @@ (it "sigchld-notification-is-consumed-once" "Child-process notifications are acknowledged once outside the signal handler." - (let ((nshell.infrastructure.acl::*children-changed* nil)) - (nshell.infrastructure.acl::shell-sigchld-handler nil nil nil) + (let ((nshell.infrastructure.acl::*children-changed* nil) + (refreshed nil)) + (with-temporary-function + ('nshell.infrastructure.acl::%refresh-sbcl-process-statuses + (lambda () (setf refreshed t))) + (nshell.infrastructure.acl::shell-sigchld-handler nil nil nil)) + (expect refreshed :to-be-truthy) (expect t :to-be (nshell.infrastructure.acl:consume-children-changed-p)) (expect nil :to-be diff --git a/t/unit/test-repl-background.lisp b/t/unit/test-repl-background.lisp index 416af3df..82dc95da 100644 --- a/t/unit/test-repl-background.lisp +++ b/t/unit/test-repl-background.lisp @@ -129,6 +129,9 @@ (let ((nshell.presentation::*background-proc-alive-p* (lambda (proc) (eq proc alive-proc))) + (nshell.presentation::*background-proc-wait* + (lambda (proc) + (declare (ignore proc)))) (nshell.presentation::*background-proc-exit-code* (lambda (proc) (declare (ignore proc)) @@ -168,6 +171,9 @@ (let ((nshell.presentation::*background-proc-alive-p* (lambda (proc) (eq proc alive-proc))) + (nshell.presentation::*background-proc-wait* + (lambda (proc) + (declare (ignore proc)))) (nshell.presentation::*background-proc-exit-code* (lambda (proc) (case proc @@ -181,6 +187,37 @@ (expect 23 :to-equal (nshell.domain.execution:job-exit-code completed-job)) (expect :created :to-be (nshell.domain.execution:job-state alive-job)))))) + (it "reap-background-jobs-waits-before-reading-exit-status" + "Reaping should collect each completed process before reading its status." + (with-repl-test-state + (let* ((monitor (nshell.domain.job-control:make-job-monitor)) + (job (make-test-job 0 "pipeline")) + (proc-1 :proc-1) + (proc-2 :proc-2) + (job-id (nshell.domain.job-control:monitor-add-job monitor job)) + (events nil)) + (let ((nshell.application:*job-monitor* monitor)) + (repl-test-register-process-entry job-id (list proc-1 proc-2)) + (let ((nshell.presentation::*background-proc-alive-p* + (lambda (proc) + (declare (ignore proc)) + nil)) + (nshell.presentation::*background-proc-wait* + (lambda (proc) + (push (list :wait proc) events))) + (nshell.presentation::*background-proc-exit-code* + (lambda (proc) + (push (list :status proc) events) + (if (eq proc proc-1) 11 23)))) + (nshell.presentation::reap-background-jobs)) + (expect (list (list :wait proc-1) + (list :status proc-1) + (list :wait proc-2) + (list :status proc-2)) + :to-equal + (nreverse events)) + (expect 23 :to-equal (nshell.domain.execution:job-exit-code job)))))) + (it "reap-background-jobs-normalizes-signaled-process-status" "Completed background jobs should store shell-compatible signal exit statuses." (with-repl-test-state @@ -218,6 +255,9 @@ (lambda (proc) (declare (ignore proc)) nil)) + (nshell.presentation::*background-proc-wait* + (lambda (proc) + (declare (ignore proc)))) (nshell.presentation::*background-proc-exit-code* (lambda (proc) (case proc