[Guile-commits] GNU Guile branch, branch_release-1-8, updated. release_1-8-6-52-g3ed47d2

[Neil Jerram]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3ed47d2203077ae732fdbdd24c211df6710a8478

The branch, branch_release-1-8 has been updated
       via  3ed47d2203077ae732fdbdd24c211df6710a8478 (commit)
      from  0310b348a1ebcd0e8aea86606ab6b32ff509d107 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 3ed47d2203077ae732fdbdd24c211df6710a8478
Author: Neil Jerram <address@hidden>
Date:   Sun Sep 7 16:29:05 2008 +0100

    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.

-----------------------------------------------------------------------

Summary of changes:
 test-suite/tests/popen.test |  108 ++++++++++++++++++++++++++++++------------
 1 files changed, 77 insertions(+), 31 deletions(-)

diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 1dd2bc7..08bfa7c 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


hooks/post-receive
-- 
GNU Guile