Avoid "no duplicate" popen tests leaving zombie processes

On the one hand we want the child process in these tests to exit.  On
the other, we don't want it to exit before the parent Guile code has
tested the relevant condition (EOF in the first test, broken pipe in
the second) - because these conditions would obviously be true if the
child had already exited, and that's not what we're trying to test
here.  We're trying to test getting EOF and broken pipe while the
child process is still alive.

* test-suite/tests/popen.test (open-input-pipe:no duplicate): Add
  another pipe from parent to child, so that the child can finish by
  reading from this.  Then the parent controls the child lifetime by
  writing to this pipe.

* test-suite/tests/popen.test (open-output-pipe:no duplicate): Add
  another pipe from child to parent, and have the child finish by
  endlessly writing into this.  Then the parent controls the child
  lifetime by closing its end of the pipe, causing a broken pipe in
  the child.

1 files changed, 77 insertions, 31 deletions

diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 1dd2bc78e..08bfa7cb4 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -73,20 +73,46 @@
 	      (open-input-pipe "echo hello"))))))
     #t)
   
+  (pass-if "open-input-pipe process gets (current-input-port) as stdin"
+    (let* ((p2c (pipe))
+           (port (with-input-from-port (car p2c)
+                   (lambda ()
+                     (open-input-pipe "read && echo $REPLY")))))
+      (display "hello\n" (cdr p2c))
+      (force-output (cdr p2c))
+      (let ((result (eq? (read port) 'hello)))
+	(close-port (cdr p2c))
+	(close-pipe port)
+	result)))
+
   ;; After the child closes stdout (which it indicates here by writing
-  ;; "closed" to stderr), the parent should see eof.  In Guile 1.6.4 and
-  ;; earlier a duplicate of stdout existed in the child, meaning eof was not
-  ;; seen.
+  ;; "closed" to stderr), the parent should see eof.  In Guile 1.6.4
+  ;; and earlier a duplicate of stdout existed in the child, meaning
+  ;; eof was not seen.
+  ;;
+  ;; Note that the objective here is to test that the parent sees EOF
+  ;; while the child is still alive.  (It is obvious that the parent
+  ;; must see EOF once the child has died.)  The use of the `p2c'
+  ;; pipe, and `echo closed' and `read' in the child, allows us to be
+  ;; sure that we are testing what the parent sees at a point where
+  ;; the child has closed stdout but is still alive.
   (pass-if "no duplicate"
-    (let* ((pair (pipe))
-	   (port (with-error-to-port (cdr pair)
+    (let* ((c2p (pipe))
+	   (p2c (pipe))
+	   (port (with-error-to-port (cdr c2p)
 		   (lambda ()
-		     (open-input-pipe
-		      "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
-      (close-port (cdr pair))   ;; write side
-      (and (char? (read-char (car pair))) ;; wait for child to do its thing
-	   (char-ready? port)
-	   (eof-object? (read-char port))))))
+		     (with-input-from-port (car p2c)
+		       (lambda ()
+			 (open-input-pipe
+			  "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read")))))))
+      (close-port (cdr c2p))   ;; write side
+      (let ((result (eof-object? (read-char port))))
+	(display "hello!\n" (cdr p2c))
+	(force-output (cdr p2c))
+	(close-pipe port)
+	result)))
+
+  )
 
 ;;
 ;; open-output-pipe
@@ -121,27 +147,47 @@
     #t)
   
   ;; After the child closes stdin (which it indicates here by writing
-  ;; "closed" to stderr), the parent should see a broken pipe.  We setup to
-  ;; see this as EPIPE (rather than SIGPIPE).  In Guile 1.6.4 and earlier a
-  ;; duplicate of stdin existed in the child, preventing the broken pipe
-  ;; occurring.
+  ;; "closed" to stderr), the parent should see a broken pipe.  We
+  ;; setup to see this as EPIPE (rather than SIGPIPE).  In Guile 1.6.4
+  ;; and earlier a duplicate of stdin existed in the child, preventing
+  ;; the broken pipe occurring.
+  ;;
+  ;; Note that the objective here is to test that the parent sees a
+  ;; broken pipe while the child is still alive.  (It is obvious that
+  ;; the parent will see a broken pipe once the child has died.)  The
+  ;; use of the `c2p' pipe, and the repeated `echo closed' in the
+  ;; child, allows us to be sure that we are testing what the parent
+  ;; sees at a point where the child has closed stdin but is still
+  ;; alive.
+  ;;
+  ;; Note that `with-epipe' must apply only to the parent and not to
+  ;; the child process; we rely on the child getting SIGPIPE, to
+  ;; terminate it (and avoid leaving a zombie).
   (pass-if "no duplicate"
-    (with-epipe
-     (lambda ()
-       (let* ((pair (pipe))
-	      (port (with-error-to-port (cdr pair)
-		      (lambda ()
-			(open-output-pipe
-			 "exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
-	 (close-port (cdr pair))   ;; write side
-	 (and (char? (read-char (car pair))) ;; wait for child to do its thing
-	      (catch 'system-error
-		(lambda ()
-		  (write-char #\x port)
-		  (force-output port)
-		  #f)
-		(lambda (key name fmt args errno-list)
-		  (= (car errno-list) EPIPE)))))))))
+    (let* ((c2p (pipe))
+	   (port (with-error-to-port (cdr c2p)
+		   (lambda ()
+		     (open-output-pipe
+		      "exec 0</dev/null; while true; do echo closed 1>&2; done")))))
+      (close-port (cdr c2p))   ;; write side
+      (with-epipe
+       (lambda ()
+	 (let ((result
+		(and (char? (read-char (car c2p))) ;; wait for child to do its thing
+		     (catch 'system-error
+			    (lambda ()
+			      (write-char #\x port)
+			      (force-output port)
+			      #f)
+			    (lambda (key name fmt args errno-list)
+			      (= (car errno-list) EPIPE))))))
+	   ;; Now close our reading end of the pipe.  This should give
+	   ;; the child a broken pipe and so allow it to exit.
+	   (close-port (car c2p))
+	   (close-pipe port)
+	   result)))))
+
+  )
 
 ;;
 ;; close-pipe