1
;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*-
3
;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
5
;;;; This library is free software; you can redistribute it and/or
6
;;;; modify it under the terms of the GNU Lesser General Public
7
;;;; License as published by the Free Software Foundation; either
8
;;;; version 2.1 of the License, or (at your option) any later version.
10
;;;; This library is distributed in the hope that it will be useful,
11
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13
;;;; Lesser General Public License for more details.
15
;;;; You should have received a copy of the GNU Lesser General Public
16
;;;; License along with this library; if not, write to the Free Software
17
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19
(define-module (test-suite test-ice-9-popen)
20
#:use-module (test-suite lib)
21
#:use-module (ice-9 popen))
24
;; read from PORT until eof is reached, return what's read as a string
25
(define (read-string-to-eof port)
26
(do ((lst '() (cons c lst))
27
(c (read-char port) (read-char port)))
29
(list->string (reverse! lst)))))
31
;; call (THUNK), with SIGPIPE set to SIG_IGN so that an EPIPE error is
32
;; generated rather than a SIGPIPE signal
33
(define (with-epipe thunk)
36
(sigaction SIGPIPE SIG_IGN))
45
(with-test-prefix "open-input-pipe"
47
(pass-if-exception "no args" exception:wrong-num-args
51
(port? (open-input-pipe "echo hello")))
54
(string=? "hello\n" (read-string-to-eof (open-input-pipe "echo hello"))))
56
;; exercise file descriptor setups when stdin is the same as stderr
57
(pass-if "stdin==stderr"
58
(let ((port (open-file "/dev/null" "r+")))
59
(with-input-from-port port
61
(with-error-to-port port
63
(open-input-pipe "echo hello"))))))
66
;; exercise file descriptor setups when stdout is the same as stderr
67
(pass-if "stdout==stderr"
68
(let ((port (open-file "/dev/null" "r+")))
69
(with-output-to-port port
71
(with-error-to-port port
73
(open-input-pipe "echo hello"))))))
76
;; After the child closes stdout (which it indicates here by writing
77
;; "closed" to stderr), the parent should see eof. In Guile 1.6.4 and
78
;; earlier a duplicate of stdout existed in the child, meaning eof was not
80
(pass-if "no duplicate"
82
(port (with-error-to-port (cdr pair)
85
"exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
86
(close-port (cdr pair)) ;; write side
87
(and (char? (read-char (car pair))) ;; wait for child to do its thing
89
(eof-object? (read-char port))))))
95
(with-test-prefix "open-output-pipe"
97
(pass-if-exception "no args" exception:wrong-num-args
101
(port? (open-output-pipe "exit 0")))
103
;; exercise file descriptor setups when stdin is the same as stderr
104
(pass-if "stdin==stderr"
105
(let ((port (open-file "/dev/null" "r+")))
106
(with-input-from-port port
108
(with-error-to-port port
110
(open-output-pipe "exit 0"))))))
113
;; exercise file descriptor setups when stdout is the same as stderr
114
(pass-if "stdout==stderr"
115
(let ((port (open-file "/dev/null" "r+")))
116
(with-output-to-port port
118
(with-error-to-port port
120
(open-output-pipe "exit 0"))))))
123
;; After the child closes stdin (which it indicates here by writing
124
;; "closed" to stderr), the parent should see a broken pipe. We setup to
125
;; see this as EPIPE (rather than SIGPIPE). In Guile 1.6.4 and earlier a
126
;; duplicate of stdin existed in the child, preventing the broken pipe
128
(pass-if "no duplicate"
132
(port (with-error-to-port (cdr pair)
135
"exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
136
(close-port (cdr pair)) ;; write side
137
(and (char? (read-char (car pair))) ;; wait for child to do its thing
140
(write-char #\x port)
143
(lambda (key name fmt args errno-list)
144
(= (car errno-list) EPIPE)))))))))
150
(with-test-prefix "close-pipe"
152
(pass-if-exception "no args" exception:wrong-num-args
156
(let ((st (close-pipe (open-output-pipe "exit 0"))))
157
(and (status:exit-val st)
158
(= 0 (status:exit-val st)))))
161
(let ((st (close-pipe (open-output-pipe "exit 1"))))
162
(and (status:exit-val st)
163
(= 1 (status:exit-val st))))))
added
removed
test-suite/tests/popen.test
