From 6069e9733163cf802e806bfa55cb4fcc54fc6ac7 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Thu, 10 Jun 2010 23:40:41 +0100
Subject: [PATCH] Fix hanging of popen.test

The "open-output-pipe":"no duplicate" test has been hanging, on and
off, and not completely reliably, for a few years.  It's now doing so
fairly reliably for me, and investigation shows that

- the child shell process is in a tight loop (99% CPU)

- the parent Guile process is stuck calling waitpid().

The problem is that the child hasn't got the SIGPIPE that the test
intends, and so is continuing to echo "closed" forever; and Guile is
waiting for it to terminate, forever.

I haven't fully debugged the SIGPIPE problem, but it sounds very like
what Chet Ramey describes here:
http://old.nabble.com/Re%3A-SIGPIPE-not-properly-reset-with-%27trap---PIPE%27-p20985595.html.

(And my version of bash is 3.2.39.)

So, a fix should be to use something other than shell to implement the
child; and it appears that this works.

* check-guile.in (TEST_SUITE_DIR): Export.

* test-suite/tests/popen-child.scm: New script file.

* test-suite/tests/popen.test ("open-output-pipe", "no duplicate"):
  Use Guile for the child process, instead of shell.
---
 check-guile.in                   | 1 +
 test-suite/tests/popen-child.scm | 5 +++++
 test-suite/tests/popen.test      | 5 +++--
 3 files changed, 9 insertions(+), 2 deletions(-)
 create mode 100644 test-suite/tests/popen-child.scm

diff --git a/check-guile.in b/check-guile.in
index dde51b37d..fc670e120 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -15,6 +15,7 @@ top_builddir=@top_builddir_absolute@
 top_srcdir=@top_srcdir_absolute@
 
 TEST_SUITE_DIR=${top_srcdir}/test-suite
+export TEST_SUITE_DIR
 
 if [ x"$1" = x-i ] ; then
     guile=$2
diff --git a/test-suite/tests/popen-child.scm b/test-suite/tests/popen-child.scm
new file mode 100644
index 000000000..423817b43
--- /dev/null
+++ b/test-suite/tests/popen-child.scm
@@ -0,0 +1,5 @@
+(close-port (current-input-port))
+(let loop ()
+  (display "closed\n" (current-error-port))
+  (force-output  (current-error-port))
+  (loop))
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 0a20cff7a..a408c9e00 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -167,8 +167,9 @@
     (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")))))
+		     (open-output-pipe (format #f
+                                               "guile -s ~a/tests/popen-child.scm"
+                                               (getenv "TEST_SUITE_DIR")))))))
       (close-port (cdr c2p))   ;; write side
       (with-epipe
        (lambda ()