1.0.31.27: RUN-PROGRAM process group change
authorJuho Snellman <jsnell@iki.fi>
Sat, 3 Oct 2009 22:36:59 +0000 (22:36 +0000)
committerJuho Snellman <jsnell@iki.fi>
Sat, 3 Oct 2009 22:36:59 +0000 (22:36 +0000)
        * Have RUN-PROGRAM with :INPUT T only run the subprocess in a
          new process group if it doesn't need to share stdin with the
          sbcl process. (patch by Leslie Polzer)

NEWS
src/runtime/run-program.c
tests/run-program.impure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 919ba5f..4a68deb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,9 @@ changes relative to sbcl-1.0.31
   * bug fix: (SETF SLOT-VALUE) signalled a warning which should have been
     an optimization note instead. (reported by Martin Cracauer)
   * bug fix: WITH-SLOTS did not work with THE forms. (thanks to David Tolpin)
+  * bug fix: Have RUN-PROGRAM with :INPUT T only run the subprocess in a
+    new process group if it doesn't need to share stdin with the sbcl
+    process. (thanks to Leslie Polzer)
 
 changes in sbcl-1.0.31 relative to sbcl-1.0.30:
   * improvement: stack allocation is should now be possible in all nested
index 77a93d5..d1d98e6 100644 (file)
@@ -65,16 +65,22 @@ int spawn(char *program, char *argv[], int sin, int sout, int serr,
     if (pid != 0)
         return pid;
 
-    /* Put us in our own process group. */
+    /* Put us in our own process group, but only if we need not
+     * share stdin with our parent. In the latter case we claim
+     * control of the terminal. */
+    if (sin >= 0) {
 #if defined(LISP_FEATURE_HPUX)
-    setsid();
+      setsid();
 #elif defined(LISP_FEATURE_DARWIN)
-    setpgid(0, getpid());
+      setpgid(0, getpid());
 #elif defined(SVR4) || defined(__linux__) || defined(__osf__)
-    setpgrp();
+      setpgrp();
 #else
-    setpgrp(0, getpid());
+      setpgrp(0, getpid());
 #endif
+    } else {
+      tcsetpgrp(0, getpgrp());
+    }
 
     /* unblock signals */
     sigemptyset(&sset);
index 01100ba..a1efdf0 100644 (file)
                     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))
+  (let (stopped)
+    (flet ((status-hook (proc)
+             (ecase (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))))))
+
index 215a110..ca52bb3 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.31.26"
+"1.0.31.27"