From 830388a1154a747b509966742ef6c49b33203870 Mon Sep 17 00:00:00 2001
From: Kevin Ryde <user42@zip.com.au>
Date: Fri, 25 Aug 2006 01:28:58 +0000
Subject: [PATCH] (open-input-pipe, open-output-pipe): In the "no duplicate"
 tests, close parent side of signalling pipe, to hopefully generate an error
 instead of a hang if something bad in the child means it doesn't write
 anything.

---
 test-suite/tests/popen.test | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 00fe81f9d..81606b774 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -107,9 +107,10 @@
 	   (port (with-error-to-port (cdr pair)
 		   (lambda ()
 		     (open-input-pipe
-		      "exec 1>/dev/null; echo closed 1>&2; sleep 999")))))
-      (read-char (car pair)) ;; wait for child to do its thing
-      (and (char-ready? port)
+		      "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))))))
 
 ;;
@@ -156,15 +157,16 @@
 	      (port (with-error-to-port (cdr pair)
 		      (lambda ()
 			(open-output-pipe
-			 "exec 0</dev/null; echo closed 1>&2; sleep 999")))))
-	 (read-char (car pair)) ;; wait for child to do its thing
-	 (catch 'system-error
+			 "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))))))))
+		  (= (car errno-list) EPIPE)))))))))
 
 ;;
 ;; close-pipe