1.0.44.4: make MAKE-FUNCTIONAL-FROM-TOPLEVEL-LAMBDA build proper XEPs

[sbcl.git] / tests / run-program.impure.lisp

diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 01100ba..46238b9 100644 (file)
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -84,24 +84,27 @@
 (defun read-linish (stream)
   (with-output-to-string (s)
     (loop for c = (read-char stream)
-       while (and c (not (eq #\newline c)) (not (eq #\return c)))
-       do (write-char c s))))
+          while (and c (not (eq #\newline c)))
+             ;; Some eds like to send \r\n
+          do (unless (eq #\return c)
+               (write-char c s)))))
 
 (defun assert-ed (command response)
   (when command
     (write-line command *ed-in*)
     (force-output *ed-in*))
-  (let ((got (read-linish *ed-out*)))
-    (unless (equal response got)
-      (error "wanted ~S from ed, got ~S" response got)))
+  (when response
+    (let ((got (read-linish *ed-out*)))
+      (unless (equal response got)
+        (error "wanted '~A' from ed, got '~A'" response got))))
   *ed*)
 
 (unwind-protect
      (with-test (:name :run-program-ed)
        (assert-ed nil "4")
-       (assert-ed ".s/bar/baz/g" "")
+       (assert-ed ".s/bar/baz/g" nil)
        (assert-ed "w" "4")
-       (assert-ed "q" "")
+       (assert-ed "q" nil)
        (process-wait *ed*)
        (with-open-file (f *tmpfile*)
          (assert (equal "baz" (read-line f)))))
@@ -146,3 +149,27 @@
                     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)
+             (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))))))
+