X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-program.impure.lisp;h=29fbd7245e82ddc848591f8c7a10890c816c2dcb;hb=f16e93459cd73b1884e3d576c95e422f8e8a000e;hp=9ef07e5014abdbaa82fc295c882f64acf74484a0;hpb=1e7fc4730aa0cafb0aba5278e8cdbdba566b8725;p=sbcl.git diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index 9ef07e5..29fbd72 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -135,3 +135,40 @@ (sb-ext:run-program "/bin/echo" ' ("It would be nice if this didn't crash.") :wait nil :output nil))))) + +(with-test (:name (:run-program :pty-stream)) + (assert (equal "OK" + (subseq + (with-output-to-string (s) + (assert (= 42 (process-exit-code + (run-program "/bin/sh" '("-c" "echo OK; exit 42") :wait t + :pty s)))) + s) + 0 + 2)))) + +;; Check whether RUN-PROGRAM puts its child process into the foreground +;; when stdin is inherited. If it fails to do so we will receive a SIGTTIN. +;; +;; We can't check for the signal itself since run-program.c resets the +;; forked process' signal mask to defaults. But the default is `stop' +;; of which we can be notified asynchronously by providing a status hook. +(with-test (:name (:run-program :inherit-stdin) + :fails-on :sbcl) + (error "Hangs at least on threaded Darwin and threaded x86-64/Linux.") + (let (stopped) + (flet ((status-hook (proc) + (case (sb-ext:process-status proc) + (:stopped (setf stopped t))))) + (let ((proc (sb-ext:run-program "/bin/ed" nil :search nil :wait nil + :input t :output t + :status-hook #'status-hook))) + ;; Give the program a generous time to generate the SIGTTIN. + ;; If it hasn't done so after that time we can consider it + ;; to be working (i.e. waiting for input without generating SIGTTIN). + (sleep 0.5) + ;; either way we have to signal it to terminate + (process-kill proc sb-posix:sigterm) + (process-close proc) + (assert (not stopped)))))) +