1 ;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*-
2 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
4 ;;;; Copyright (C) 1999 Free Software Foundation, Inc.
6 ;;;; This program is free software; you can redistribute it and/or modify
7 ;;;; it under the terms of the GNU General Public License as published by
8 ;;;; the Free Software Foundation; either version 2, or (at your option)
9 ;;;; any later version.
11 ;;;; This program is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;;; GNU General Public License for more details.
16 ;;;; You should have received a copy of the GNU General Public License
17 ;;;; along with this software; see the file COPYING. If not, write to
18 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
19 ;;;; Boston, MA 02111-1307 USA
21 (use-modules (test-suite lib)
24 (define (display-line . args)
25 (for-each display args)
32 ;;;; Some general utilities for testing ports.
34 ;;; Read from PORT until EOF, and return the result as a string.
35 (define (read-all port)
36 (let loop ((chars '()))
37 (let ((char (read-char port)))
38 (if (eof-object? char)
39 (list->string (reverse! chars))
40 (loop (cons char chars))))))
42 (define (read-file filename)
43 (let* ((port (open-input-file filename))
44 (string (read-all port)))
49 ;;;; Normal file ports.
51 ;;; Write out an s-expression, and read it back.
53 (let ((string '("From fairest creatures we desire increase,"
54 "That thereby beauty's rose might never die,"))
55 (filename (test-file)))
56 (let ((port (open-output-file filename)))
59 (let ((port (open-input-file filename)))
60 (let ((in-string (read port)))
61 (pass-if "file: write and read back list of strings"
62 (equal? string in-string)))
64 (delete-file filename)))
66 ;;; Write out a string, and read it back a character at a time.
68 (let ((string "This is a test string\nwith no newline at the end")
69 (filename (test-file)))
70 (let ((port (open-output-file filename)))
73 (let ((in-string (read-file filename)))
74 (pass-if "file: write and read back characters"
75 (equal? string in-string)))
76 (delete-file filename)))
78 ;;; Buffered input/output port with seeking.
80 (let* ((filename (test-file))
81 (port (open-file filename "w+")))
82 (display "J'Accuse" port)
83 (seek port -1 SEEK_CUR)
84 (pass-if "file: r/w 1"
85 (char=? (read-char port) #\e))
86 (pass-if "file: r/w 2"
87 (eof-object? (read-char port)))
88 (seek port -1 SEEK_CUR)
90 (seek port 7 SEEK_SET)
91 (pass-if "file: r/w 3"
92 (char=? (read-char port) #\x))
93 (seek port -2 SEEK_END)
94 (pass-if "file: r/w 4"
95 (char=? (read-char port) #\s))
96 (delete-file filename)))
98 ;;; Unbuffered input/output port with seeking.
100 (let* ((filename (test-file))
101 (port (open-file filename "w+0")))
102 (display "J'Accuse" port)
103 (seek port -1 SEEK_CUR)
104 (pass-if "file: ub r/w 1"
105 (char=? (read-char port) #\e))
106 (pass-if "file: ub r/w 2"
107 (eof-object? (read-char port)))
108 (seek port -1 SEEK_CUR)
109 (write-char #\x port)
110 (seek port 7 SEEK_SET)
111 (pass-if "file: ub r/w 3"
112 (char=? (read-char port) #\x))
113 (seek port -2 SEEK_END)
114 (pass-if "file: ub r/w 4"
115 (char=? (read-char port) #\s))
116 (delete-file filename)))
118 ;;; Buffered output-only and input-only ports with seeking.
120 (let* ((filename (test-file))
121 (port (open-output-file filename)))
122 (display "J'Accuse" port)
123 (pass-if "file: out tell"
124 (= (seek port 0 SEEK_CUR) 8))
125 (seek port -1 SEEK_CUR)
126 (write-char #\x port)
128 (let ((iport (open-input-file filename)))
129 (pass-if "file: in tell 0"
130 (= (seek iport 0 SEEK_CUR) 0))
132 (pass-if "file: in tell 1"
133 (= (seek iport 0 SEEK_CUR) 1))
134 (seek iport 7 SEEK_SET)
135 (pass-if "file: in last char"
136 (char=? (read-char iport) #\x))
138 (delete-file filename)))
140 ;;; unusual characters.
142 (let* ((filename (test-file))
143 (port (open-output-file filename)))
144 (display (string #\nul (integer->char 255) (integer->char 128)
147 (let* ((port (open-input-file filename))
148 (line (read-line port)))
149 (pass-if "file: read back NUL 1"
150 (char=? (string-ref line 0) #\nul))
151 (pass-if "file: read back 255"
152 (char=? (string-ref line 1) (integer->char 255)))
153 (pass-if "file: read back 128"
154 (char=? (string-ref line 2) (integer->char 128)))
155 (pass-if "file: read back NUL 2"
156 (char=? (string-ref line 3) #\nul))
158 (eof-object? (read-char port))))
159 (delete-file filename)))
161 ;;; line buffering mode.
163 (let* ((filename (test-file))
164 (port (open-file filename "wl"))
165 (test-string "one line more or less"))
166 (write-line test-string port)
167 (let* ((in-port (open-input-file filename))
168 (line (read-line in-port)))
171 (pass-if "file: line buffering"
172 (string=? line test-string)))
173 (delete-file filename)))
175 ;;; ungetting characters and strings.
177 (with-input-from-string "walk on the moon\nmoon"
180 (unread-char #\a (current-input-port))
181 (pass-if "unread-char"
182 (char=? (read-char) #\a))
184 (let ((replacenoid "chicken enchilada"))
185 (unread-char #\newline (current-input-port))
186 (unread-string replacenoid (current-input-port))
187 (pass-if "unread-string"
188 (string=? (read-line) replacenoid)))
189 (pass-if "unread residue"
190 (string=? (read-line) "moon")))))
192 ;;; non-blocking mode on a port. create a pipe and set O_NONBLOCK on
193 ;;; the reading end. try to read a byte: should get EAGAIN error.
197 (fcntl r F_SETFL O_NONBLOCK)
198 (pass-if "non-blocking-I/O"
200 (lambda () (read-char r) #f)
202 (and (eq? key 'system-error)
203 (= (car (list-ref args 3)) EAGAIN)))))))
206 ;;;; Pipe (popen) ports.
208 ;;; Run a command, and read its output.
210 (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r"))
211 (in-string (read-all pipe)))
213 (pass-if "pipe: read"
214 (equal? in-string "Howdy there, partner!\n"))))
216 ;;; Run a command, send some output to it, and see if it worked.
218 (let* ((filename (test-file))
219 (pipe (open-pipe (string-append "grep Mommy > " filename) "w")))
220 (display "Now Jimmy lives on a mushroom cloud\n" pipe)
221 (display "Mommy, why does everybody have a bomb?\n" pipe)
223 (let ((in-string (read-file filename)))
224 (pass-if "pipe: write"
225 (equal? in-string "Mommy, why does everybody have a bomb?\n")))
226 (delete-file filename)))
229 ;;;; Void ports. These are so trivial we don't test them.
234 (with-test-prefix "string ports"
236 ;; Write text to a string port.
238 (let* ((string "Howdy there, partner!")
239 (in-string (call-with-output-string
241 (display string port)
243 (pass-if "display text"
244 (equal? in-string (string-append string "\n")))))
246 ;; Write an s-expression to a string port.
248 (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
250 (call-with-input-string (call-with-output-string
254 (pass-if "write/read sexpr"
255 (equal? in-sexpr sexpr)))))
258 ;;;; Soft ports. No tests implemented yet.
261 ;;;; Generic operations across all port types.
263 (let ((port-loop-temp (test-file)))
265 ;; Return a list of input ports that all return the same text.
266 ;; We map tests over this list.
267 (define (input-port-list text)
269 ;; Create a text file some of the ports will use.
270 (let ((out-port (open-output-file port-loop-temp)))
271 (display text out-port)
272 (close-port out-port))
274 (list (open-input-file port-loop-temp)
275 (open-input-pipe (string-append "cat " port-loop-temp))
276 (call-with-input-string text (lambda (x) x))
277 ;; We don't test soft ports at the moment.
280 (define port-list-names '("file" "pipe" "string"))
282 ;; Test the line counter.
283 (define (test-line-counter text second-line final-column)
284 (with-test-prefix "line counter"
285 (let ((ports (input-port-list text)))
287 (lambda (port port-name)
288 (with-test-prefix port-name
289 (pass-if "at beginning of input"
290 (= (port-line port) 0))
291 (pass-if "read first character"
292 (eqv? (read-char port) #\x))
293 (pass-if "after reading one character"
294 (= (port-line port) 0))
295 (pass-if "read first newline"
296 (eqv? (read-char port) #\newline))
297 (pass-if "after reading first newline char"
298 (= (port-line port) 1))
299 (pass-if "second line read correctly"
300 (equal? (read-line port) second-line))
301 (pass-if "read-line increments line number"
302 (= (port-line port) 2))
303 (pass-if "read-line returns EOF"
306 ((eof-object? (read-line port)) #t)
308 (else (loop (+ i 1))))))
309 (pass-if "line count is 5 at EOF"
310 (= (port-line port) 5))
311 (pass-if "column is correct at EOF"
312 (= (port-column port) final-column))))
313 ports port-list-names)
314 (for-each close-port ports)
315 (delete-file port-loop-temp))))
318 (with-test-prefix "newline"
321 "He who receives an idea from me, receives instruction\n"
322 "himself without lessening mine; as he who lights his\n"
323 "taper at mine, receives light without darkening me.\n"
324 " --- Thomas Jefferson\n")
325 "He who receives an idea from me, receives instruction"
329 (with-test-prefix "no newline"
332 "He who receives an idea from me, receives instruction\n"
333 "himself without lessening mine; as he who lights his\n"
334 "taper at mine, receives light without darkening me.\n"
335 " --- Thomas Jefferson\n"
337 "He who receives an idea from me, receives instruction"
341 ;;;; testing read-delimited and friends
343 (with-test-prefix "read-delimited!"
344 (let ((c (make-string 20 #\!)))
345 (call-with-input-string
349 (read-delimited! "\n" c port 'concat)
350 (pass-if "read-delimited! reads a first line"
351 (string=? c "defdef\n!!!!!!!!!!!!!"))
353 (read-delimited! "\n" c port 'concat 3)
354 (pass-if "read-delimited! reads a first line"
355 (string=? c "defghighi\n!!!!!!!!!!"))))))
360 (call-with-input-string
363 (pass-if "char-ready? returns true on string port"
364 (char-ready? port))))
366 ;;; This segfaults on some versions of Guile. We really should run
367 ;;; the tests in a subprocess...
369 (call-with-input-string
372 (with-input-from-port
375 (pass-if "char-ready? returns true on string port as default port"
379 ;;;; Close current-input-port, and make sure everyone can handle it.
381 (with-test-prefix "closing current-input-port"
382 (for-each (lambda (procedure name)
383 (with-input-from-port
384 (call-with-input-string "foo" (lambda (p) p))
386 (close-port (current-input-port))
388 (signals-error? 'wrong-type-arg (procedure))))))
389 (list read read-char read-line)
390 '("read" "read-char" "read-line")))