mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-12 00:30:20 +02:00
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.
This commit is contained in:
parent
0310b348a1
commit
3ed47d2203
1 changed files with 77 additions and 31 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue