Re: "no duplicate" in `popen.test'

[Neil Jerram]

"Neil Jerram" <address@hidden> writes:

> 2008/5/19 Ludovic Courtès <address@hidden>:
>>
>> Can you apply this patch?
>
> Well...  Looking at the patch again, I thought "but it can't be right
> to do a display to port, when port comes from open-input-pipe".  And
> then I tried running the test again, with the patch in place, and:
>
> ERROR: open-input-pipe: no duplicate - arguments: ((wrong-type-arg
> "display" "Wrong type argument in position ~A: ~S" (2 #<input: #{read\
> pipe}# 13>) (#<input:
> #{read\ pipe}# 13>)))
>
> I'm not currently sure why I missed that before, but I'm working on a
> better patch.

I finally got back to this.  I'm pretty sure the attached patch is now
correct, so will commit in a couple of days unless anyone objects.

Regards,
        Neil

>From f7329523787596bb7ea5c00f05c60d8649e16eab Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Sun, 7 Sep 2008 16:29:05 +0100
Subject: [PATCH] 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.
---
 test-suite/tests/popen.test |   86 +++++++++++++++++++++++++++++--------------
 1 files changed, 58 insertions(+), 28 deletions(-)

diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 1dd2bc7..c4b7477 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -73,20 +73,39 @@
              (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.
   (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 +140,38 @@
     #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 `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
-- 
1.5.6.5