test: distinguish terminated assistant workers from join timeouts

README.md

@@ -20,7 +20,7 @@ The release and Nix flake support `x86_64-linux` only. With
 [Nix](https://nixos.org/download) and flakes enabled:
 
 ```sh
-nix run github:nerima-lisp/nshell/v0.6.5
+nix run github:nerima-lisp/nshell/v0.6.6
 ```
 
 At the prompt, enter `string upper hello`. Commands and paths colorize live, and a
@@ -62,7 +62,7 @@ and session settings.
 ## Install
 
 ```sh
-nix profile install github:nerima-lisp/nshell/v0.6.5
+nix profile install github:nerima-lisp/nshell/v0.6.6
 ```
 
 Pin a release tag rather than following the default branch.

nshell.asd

@@ -19,7 +19,7 @@
   :license "MIT"
   ;; Single source of truth for the version. flake.nix reads this form
   ;; line-by-line, and release.yml refuses a tag that disagrees with it.
-  :version "0.6.5"
+  :version "0.6.6"
   :homepage "https://github.com/nerima-lisp/nshell"
   :bug-tracker "https://github.com/nerima-lisp/nshell/issues"
   :source-control (:git "https://github.com/nerima-lisp/nshell.git")
@@ -403,7 +403,7 @@
   :in-order-to ((test-op (test-op "nshell/test"))))
 
 (asdf:defsystem "nshell/test"
-  :version "0.6.5"
+  :version "0.6.6"
   :author "takeokunn <bararararatty@gmail.com>"
   :maintainer "takeokunn <bararararatty@gmail.com>"
   :license "MIT"
@@ -590,7 +590,7 @@
                 (error "cl-weave tests failed"))))
 
 (asdf:defsystem "nshell/weave"
-  :version "0.6.5"
+  :version "0.6.6"
   :author "takeokunn <bararararatty@gmail.com>"
   :maintainer "takeokunn <bararararatty@gmail.com>"
   :license "MIT"
@@ -620,7 +620,7 @@ primary suite in nshell/test."
                               :reporter :spec)
                (error "cl-weave suite failed"))))
 (asdf:defsystem "nshell/benchmark"
-  :version "0.6.5"
+  :version "0.6.6"
   :author "takeokunn <bararararatty@gmail.com>"
   :maintainer "takeokunn <bararararatty@gmail.com>"
   :license "MIT"

src/infrastructure/acl/syscall-process-execution.lisp

@@ -23,8 +23,8 @@ file` typed at an interactive prompt too."
 (defun run-external-exec (cmd args)
   "Execute CMD with ARGS for the exec builtin.
 
-Standard streams pass through directly and noninteractive execution uses the
-normal foreground timeout policy."
+FD-backed standard streams pass through directly; other output streams are
+drained under the normal foreground timeout policy."
   (handler-case
       (multiple-value-bind (resolved-cmd environment)
           (%prepare-external-command cmd)
@@ -33,23 +33,21 @@ normal foreground timeout policy."
           (return-from run-external-exec 127))
         (let ((proc (%spawn-in-own-process-group
                      resolved-cmd args environment
-                     *standard-input* *standard-output*
-                     :error *error-output*)))
+                     *standard-input* (%external-output-target *standard-output*)
+                     :error (%external-output-target *error-output*))))
           (if proc
               (let* ((pid (sb-ext:process-pid proc))
                      (pgid (and (integerp pid) (plusp pid) pid))
                      (timeout (%foreground-external-command-timeout)))
                 (%with-foreground-process-group-if (pgid)
-                  (if (or (null timeout)
-                          (%wait-process-exit-with-timeout proc timeout))
-                      (progn
-                        (%wait-sbcl-process proc)
-                        (process-exit-status-code proc))
-                      (progn
-                        (%terminate-process proc)
-                        (format *error-output* "~a"
-                                (%external-command-timeout-message cmd timeout))
-                        124))))
+                  (values
+                   (%wait-process-with-output
+                    proc *standard-output* timeout
+                    (lambda ()
+                      (format *error-output* "~a"
+                              (%external-command-timeout-message cmd timeout))
+                      124)
+                    *error-output*))))
               1)))
     (error (err)
       (format *error-output* "exec: ~a: ~a~%" cmd err)
@@ -65,7 +63,10 @@ normal foreground timeout policy."
           (return-from run-external 127))
         (let ((proc (%spawn-external-command resolved-cmd args environment
                                              :input *standard-input*
-                                             :output :stream)))
+                                             :output :stream
+                                             :error (if *redirected-stderr*
+                                                        (%external-output-target *error-output*)
+                                                        :output))))
           (if proc
               (let* ((pid (sb-ext:process-pid proc))
                      (pgid (and (integerp pid) (plusp pid) pid))
@@ -78,7 +79,8 @@ normal foreground timeout policy."
                    (lambda ()
                      (format *error-output* "~a"
                              (%external-command-timeout-message cmd timeout))
-                     124))))
+                     124)
+                   *error-output*)))
               1)))
     (error (err)
       (format *error-output* "nshell: ~a: ~a~%" cmd err)

src/infrastructure/acl/syscall-process-io.lisp

@@ -1,5 +1,12 @@
 (in-package #:nshell.infrastructure.acl)
 
+(defun %external-output-target (output)
+  ;; SBCL's internal copier for non-FD streams has no drain deadline.
+  (if (and (streamp output)
+           (null (sb-impl::get-stream-fd-and-external-format output :output)))
+      :stream
+      output))
+
 (defun %process-result-shell-exit (result)
   "Map a cl-process-kit PROCESS-RESULT to a shell exit status."
   (let ((code (process-kit:process-result-exit-code result))

src/infrastructure/acl/syscall-process.lisp

@@ -118,12 +118,31 @@
      (%join-process-output-copiers ,copiers)))
 
 (defun %wait-process-with-copiers (proc copiers timeout-seconds success-fn timeout-fn)
-  (funcall
-   (%with-process-output-copiers (copiers)
-     (if (or (null timeout-seconds)
-             (%wait-process-exit-with-timeout proc timeout-seconds))
-         (progn (%wait-sbcl-process proc) success-fn)
-         (progn (%terminate-process proc) timeout-fn)))))
+  (let ((copiers (remove nil copiers))
+        (callback success-fn)
+        (timed-out-p nil)
+        (deadline (when timeout-seconds
+                    (+ (get-internal-real-time)
+                       (round (* timeout-seconds internal-time-units-per-second))))))
+    (unwind-protect
+         (progn
+           (loop while (or (sb-ext:process-alive-p proc)
+                           (some #'sb-thread:thread-alive-p copiers))
+                 do (when (and deadline (>= (get-internal-real-time) deadline))
+                      (when (sb-ext:process-alive-p proc)
+                        (%terminate-process proc))
+                      (setf callback timeout-fn
+                            timed-out-p t)
+                      (return))
+                    (sb-sys:serve-all-events 0.01))
+           (unless timed-out-p
+             (%wait-sbcl-process proc)))
+      ;; Descendants may keep output pipes open after the owned process exits.
+      (dolist (copier copiers)
+        (when (sb-thread:thread-alive-p copier)
+          (sb-thread:terminate-thread copier))
+        (%join-stream-copier copier)))
+    (funcall callback)))
 
 (defun %wait-process-with-copiers-or-stop (proc copiers success-fn stop-fn)
   "Wait for PROC while allowing a stopped process to be continued."
@@ -136,11 +155,26 @@
         (return (funcall (%with-process-output-copiers (copiers)
                            success-fn))))))
 
-(defun %wait-process-with-output (proc output timeout-seconds timeout-fn)
-  (let ((copier (%start-process-output-copier proc output)))
-    (%wait-process-with-copiers proc (list copier) timeout-seconds
-      (lambda () (values (process-exit-status-code proc) nil))
-      (lambda () (values (funcall timeout-fn) t)))))
+(defun %wait-process-with-output (proc output timeout-seconds timeout-fn
+                                 &optional error-output)
+  (let ((copiers nil))
+    (unwind-protect
+         (progn
+           (push (%start-process-output-copier proc output) copiers)
+           (let ((error-stream (sb-ext:process-error proc)))
+             (when (and error-stream
+                        (not (eq error-stream (sb-ext:process-output proc))))
+               (push (%start-stream-copier error-stream error-output
+                                          "nshell process error copier")
+                     copiers)))
+           (%wait-process-with-copiers proc copiers timeout-seconds
+             (lambda () (values (process-exit-status-code proc) nil))
+             (lambda () (values (funcall timeout-fn) t))))
+      (dolist (copier copiers)
+        (when (and copier (sb-thread:thread-alive-p copier))
+          (sb-thread:terminate-thread copier))
+        (%join-stream-copier copier))
+      (sb-ext:process-close proc))))
 
 (defun spawn-async (cmd args &key redirects)
   "Spawn CMD with ARGS asynchronously. Returns the process or NIL on error."

t/integration/test-process.lisp

@@ -12,6 +12,59 @@
         "--eval"
         form))
 
+(defun %check-orphaned-external-output-timeout (executor separate-stderr-p fd-output-p)
+  (with-temporary-output-file (pid-file :prefix "nshell-external-orphan")
+    (with-temporary-output-file (output-file :prefix "nshell-external-output")
+      (let ((worker nil) (result nil) (failure nil) (join-reason nil)
+            (cleanup-join-reason nil) (worker-alive-p nil) (child-alive-p nil)
+            (child-kill-result nil) (error-output nil))
+        (unwind-protect
+             (progn
+               (setf worker
+                     (sb-thread:make-thread
+                      (lambda ()
+                        (handler-case
+                            (with-open-file (file-output output-file :direction :output
+                                                         :if-does-not-exist :create)
+                              (let ((nshell.infrastructure.acl:*external-command-timeout* 0.2)
+                                    (nshell.infrastructure.acl::*redirected-stderr*
+                                      separate-stderr-p)
+                                    (*standard-output*
+                                      (if fd-output-p file-output
+                                          (make-string-output-stream))))
+                                (setf error-output
+                                      (with-output-to-string (*error-output*)
+                                        (setf result
+                                              (funcall executor "/bin/sh"
+                                                       (list "-c"
+                                                             "sleep 3 & printf '%s' \"$!\" > \"$1\""
+                                                             "nshell-test" pid-file)))))))
+                          (error (condition) (setf failure condition))))))
+               (multiple-value-bind (value reason)
+                   (sb-thread:join-thread worker :timeout 1 :default nil)
+                 (declare (ignore value))
+                 (setf join-reason reason
+                       worker-alive-p (sb-thread:thread-alive-p worker))))
+          (let ((pid (ignore-errors
+                       (parse-integer (host-kit:read-file-string pid-file)))))
+            (when pid
+              (setf child-alive-p (ignore-errors (sb-posix:kill pid 0) t)
+                    child-kill-result (ignore-errors (sb-posix:kill pid sb-unix:sigkill)))))
+          (when worker
+            (multiple-value-bind (value reason)
+                (sb-thread:join-thread worker :timeout 3 :default nil)
+              (declare (ignore value))
+              (setf cleanup-join-reason reason))))
+        (expect nil :to-equal failure)
+        (expect nil :to-equal join-reason)
+        (expect nil :to-equal worker-alive-p)
+        (expect nil :to-equal cleanup-join-reason)
+        (expect nil :to-equal (sb-thread:thread-alive-p worker))
+        (expect t :to-equal child-alive-p)
+        (expect 0 :to-equal child-kill-result)
+        (expect 124 :to-equal result)
+        (expect (search "timed out after" error-output) :to-be-truthy)))))
+
 (describe "process-tests"
   (it "spawn-terminal-command-stops-before-running-user-code"
     (with-temporary-output-file (target :prefix "nshell-terminal-barrier")
@@ -375,6 +428,20 @@ when *STANDARD-OUTPUT* is not an interactive terminal."
         (when bad-index
           (fail "unexpected character at ~d: ~s" bad-index (char output bad-index))))))
 
+  (it "run-external-merges-stderr-into-stdout-once"
+    (let ((exit nil) (output nil)
+          (nshell.infrastructure.acl::*redirected-stderr* nil))
+      (let ((error-output
+              (with-output-to-string (*error-output*)
+                (setf output
+                      (capture-standard-output
+                        (setf exit
+                              (nshell.infrastructure.acl:run-external
+                               "/bin/sh" '("-c" "printf OUT; printf ERR >&2"))))))))
+        (expect 0 :to-equal exit)
+        (expect "OUTERR" :to-equal output)
+        (expect "" :to-equal error-output))))
+
   (it "run-external-capture-echo"
     "External command capture returns stdout and exit code."
     (multiple-value-bind (output exit)
@@ -408,6 +475,63 @@ when *STANDARD-OUTPUT* is not an interactive terminal."
       (expect 124 :to-equal exit)
       (expect (search "timed out after" error-output) :to-be-truthy)))
 
+  (it "run-external-timeout-covers-orphaned-output-writer"
+    (%check-orphaned-external-output-timeout
+     #'nshell.infrastructure.acl:run-external nil nil))
+
+  (it "process-output-timeout-callback-runs-after-copier-cleanup"
+    (let* ((proc (sb-ext:run-program "/bin/sh" '("-c" "exit 0")
+                                    :input nil :output nil :error nil :wait nil))
+           (semaphore (sb-thread:make-semaphore))
+           (copier (sb-thread:make-thread
+                    (lambda () (sb-thread:wait-on-semaphore semaphore :timeout 3))))
+           (success-called-p nil) (timeout-calls 0) (callback-copier-alive-p t))
+      (unwind-protect
+           (multiple-value-bind (status timed-out-p)
+               (nshell.infrastructure.acl:%wait-process-with-copiers
+                proc (list copier) 0.2
+                (lambda () (setf success-called-p t) (values 0 nil))
+                (lambda ()
+                  (incf timeout-calls)
+                  (setf callback-copier-alive-p (sb-thread:thread-alive-p copier))
+                  (values 124 t)))
+             (expect 124 :to-equal status)
+             (expect t :to-equal timed-out-p)
+             (expect nil :to-equal success-called-p)
+             (expect 1 :to-equal timeout-calls)
+             (expect nil :to-equal callback-copier-alive-p)
+             (expect nil :to-equal (sb-thread:thread-alive-p copier)))
+        (sb-thread:signal-semaphore semaphore)
+        (ignore-errors (sb-thread:join-thread copier :timeout 3))
+        (nshell.infrastructure.acl::%terminate-process proc)
+        (sb-ext:process-close proc))))
+
+  (it "run-external-timeout-covers-orphaned-non-fd-stderr"
+    (%check-orphaned-external-output-timeout
+     #'nshell.infrastructure.acl:run-external t nil))
+
+  (it "run-external-exec-timeout-covers-orphaned-non-fd-stderr"
+    (%check-orphaned-external-output-timeout
+     #'nshell.infrastructure.acl:run-external-exec t t))
+
+  (it "run-external-exec-large-stdout-and-stderr-are-drained"
+    (let* ((size 131072)
+           (exit nil) (output nil)
+           (error-output
+             (with-output-to-string (*error-output*)
+               (setf output
+                     (capture-standard-output
+                       (setf exit
+                             (nshell.infrastructure.acl:run-external-exec
+                              (current-sbcl-executable)
+                              (%process-test-sbcl-argv
+                               (format nil
+                                       "(progn (write-string (make-string ~d :initial-element #\\x)) (write-string (make-string ~d :initial-element #\\y) *error-output*))"
+                                       size size)))))))))
+      (expect 0 :to-equal exit)
+      (expect (make-string size :initial-element #\x) :to-equal output)
+      (expect (make-string size :initial-element #\y) :to-equal error-output)))
+
   (it "run-external-timeout-terminates-descendant-processes"
     "Timeout cleanup should kill descendants that inherited stdout."
     #+unix

t/unit/test-assistant-model-boundary.lisp

@@ -446,9 +446,10 @@
                              :timeout (cl-date-kit:duration-of-seconds 2)))
                     (dolist (thread threads)
                       (expect t :to-be (not (null thread)))
-                      (expect nil :to-be
-                              (eq :timed-out
-                                  (sb-thread:join-thread thread :timeout 2 :default :timed-out)))
+                      (multiple-value-bind (value problem)
+                          (sb-thread:join-thread thread :timeout 2 :default nil)
+                        (declare (ignore value))
+                        (expect nil :to-be (eq :timeout problem)))
                       (expect nil :to-be (sb-thread:thread-alive-p thread)))
                     (let ((received (uiop:read-file-lines received-path)))
                       (expect (if unsafe-init 0 1) :to-be (length received))