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&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&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