Commit | Line | Data |
---|---|---|
3e690887 KR |
1 | ;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*- |
2 | ;;;; | |
6e7d5622 | 3 | ;;;; Copyright 2003, 2006 Free Software Foundation, Inc. |
3e690887 KR |
4 | ;;;; |
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. | |
9 | ;;;; | |
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. | |
14 | ;;;; | |
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 | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
3e690887 KR |
18 | |
19 | (define-module (test-suite test-ice-9-popen) | |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (ice-9 popen)) | |
22 | ||
23 | ||
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))) | |
28 | ((eof-object? c) | |
29 | (list->string (reverse! lst))))) | |
30 | ||
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) | |
34 | (dynamic-wind | |
35 | (lambda () | |
36 | (sigaction SIGPIPE SIG_IGN)) | |
37 | thunk | |
38 | restore-signals)) | |
39 | ||
40 | ||
41 | ;; | |
42 | ;; open-input-pipe | |
43 | ;; | |
44 | ||
45 | (with-test-prefix "open-input-pipe" | |
46 | ||
47 | (pass-if-exception "no args" exception:wrong-num-args | |
48 | (open-input-pipe)) | |
49 | ||
50 | (pass-if "port?" | |
51 | (port? (open-input-pipe "echo hello"))) | |
52 | ||
53 | (pass-if "echo hello" | |
54 | (string=? "hello\n" (read-string-to-eof (open-input-pipe "echo hello")))) | |
55 | ||
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 | |
60 | (lambda () | |
61 | (with-error-to-port port | |
62 | (lambda () | |
63 | (open-input-pipe "echo hello")))))) | |
64 | #t) | |
65 | ||
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 | |
70 | (lambda () | |
71 | (with-error-to-port port | |
72 | (lambda () | |
73 | (open-input-pipe "echo hello")))))) | |
74 | #t) | |
75 | ||
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 | |
79 | ;; seen. | |
80 | (pass-if "no duplicate" | |
81 | (let* ((pair (pipe)) | |
82 | (port (with-error-to-port (cdr pair) | |
83 | (lambda () | |
84 | (open-input-pipe | |
85 | "exec 1>/dev/null; echo closed 1>&2; sleep 999"))))) | |
86 | (read-char (car pair)) ;; wait for child to do its thing | |
87 | (and (char-ready? port) | |
88 | (eof-object? (read-char port)))))) | |
89 | ||
90 | ;; | |
91 | ;; open-output-pipe | |
92 | ;; | |
93 | ||
94 | (with-test-prefix "open-output-pipe" | |
95 | ||
96 | (pass-if-exception "no args" exception:wrong-num-args | |
97 | (open-output-pipe)) | |
98 | ||
99 | (pass-if "port?" | |
100 | (port? (open-output-pipe "exit 0"))) | |
101 | ||
930d3b37 | 102 | ;; exercise file descriptor setups when stdin is the same as stderr |
3e690887 KR |
103 | (pass-if "stdin==stderr" |
104 | (let ((port (open-file "/dev/null" "r+"))) | |
105 | (with-input-from-port port | |
106 | (lambda () | |
107 | (with-error-to-port port | |
108 | (lambda () | |
109 | (open-output-pipe "exit 0")))))) | |
110 | #t) | |
111 | ||
112 | ;; exercise file descriptor setups when stdout is the same as stderr | |
113 | (pass-if "stdout==stderr" | |
114 | (let ((port (open-file "/dev/null" "r+"))) | |
115 | (with-output-to-port port | |
116 | (lambda () | |
117 | (with-error-to-port port | |
118 | (lambda () | |
119 | (open-output-pipe "exit 0")))))) | |
120 | #t) | |
121 | ||
122 | ;; After the child closes stdin (which it indicates here by writing | |
123 | ;; "closed" to stderr), the parent should see a broken pipe. We setup to | |
124 | ;; see this as EPIPE (rather than SIGPIPE). In Guile 1.6.4 and earlier a | |
125 | ;; duplicate of stdin existed in the child, preventing the broken pipe | |
126 | ;; occurring. | |
127 | (pass-if "no duplicate" | |
128 | (with-epipe | |
129 | (lambda () | |
130 | (let* ((pair (pipe)) | |
131 | (port (with-error-to-port (cdr pair) | |
132 | (lambda () | |
133 | (open-output-pipe | |
134 | "exec 0</dev/null; echo closed 1>&2; sleep 999"))))) | |
135 | (read-char (car pair)) ;; wait for child to do its thing | |
136 | (catch 'system-error | |
137 | (lambda () | |
138 | (write-char #\x port) | |
139 | (force-output port) | |
140 | #f) | |
141 | (lambda (key name fmt args errno-list) | |
142 | (= (car errno-list) EPIPE)))))))) | |
143 | ||
144 | ;; | |
145 | ;; close-pipe | |
146 | ;; | |
147 | ||
930d3b37 | 148 | (with-test-prefix "close-pipe" |
3e690887 KR |
149 | |
150 | (pass-if-exception "no args" exception:wrong-num-args | |
151 | (close-pipe)) | |
152 | ||
153 | (pass-if "exit 0" | |
154 | (let ((st (close-pipe (open-output-pipe "exit 0")))) | |
155 | (and (status:exit-val st) | |
156 | (= 0 (status:exit-val st))))) | |
157 | ||
158 | (pass-if "exit 1" | |
159 | (let ((st (close-pipe (open-output-pipe "exit 1")))) | |
160 | (and (status:exit-val st) | |
161 | (= 1 (status:exit-val st)))))) | |
162 |