Commit | Line | Data |
---|---|---|
0d572e91 | 1 | ;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*- |
7ef450bf | 2 | ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 |
000ee07f | 3 | ;;;; |
6e7d5622 | 4 | ;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc. |
000ee07f JB |
5 | ;;;; |
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. | |
10 | ;;;; | |
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. | |
15 | ;;;; | |
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 | |
92205699 MV |
18 | ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
19 | ;;;; Boston, MA 02110-1301 USA | |
000ee07f | 20 | |
8aa28a91 DH |
21 | (define-module (test-suite test-ports) |
22 | :use-module (test-suite lib) | |
23 | :use-module (test-suite guile-test) | |
24 | :use-module (ice-9 popen) | |
25 | :use-module (ice-9 rdelim)) | |
000ee07f JB |
26 | |
27 | (define (display-line . args) | |
28 | (for-each display args) | |
29 | (newline)) | |
30 | ||
31 | (define (test-file) | |
c685b42f | 32 | (data-file-name "ports-test.tmp")) |
000ee07f JB |
33 | |
34 | \f | |
35 | ;;;; Some general utilities for testing ports. | |
36 | ||
37 | ;;; Read from PORT until EOF, and return the result as a string. | |
38 | (define (read-all port) | |
39 | (let loop ((chars '())) | |
40 | (let ((char (read-char port))) | |
41 | (if (eof-object? char) | |
42 | (list->string (reverse! chars)) | |
43 | (loop (cons char chars)))))) | |
44 | ||
45 | (define (read-file filename) | |
46 | (let* ((port (open-input-file filename)) | |
47 | (string (read-all port))) | |
48 | (close-port port) | |
49 | string)) | |
50 | ||
51 | \f | |
52 | ;;;; Normal file ports. | |
53 | ||
54 | ;;; Write out an s-expression, and read it back. | |
57e7f270 DH |
55 | (let ((string '("From fairest creatures we desire increase," |
56 | "That thereby beauty's rose might never die,")) | |
57 | (filename (test-file))) | |
58 | (let ((port (open-output-file filename))) | |
59 | (write string port) | |
60 | (close-port port)) | |
61 | (let ((port (open-input-file filename))) | |
62 | (let ((in-string (read port))) | |
63 | (pass-if "file: write and read back list of strings" | |
64 | (equal? string in-string))) | |
65 | (close-port port)) | |
66 | (delete-file filename)) | |
000ee07f JB |
67 | |
68 | ;;; Write out a string, and read it back a character at a time. | |
57e7f270 DH |
69 | (let ((string "This is a test string\nwith no newline at the end") |
70 | (filename (test-file))) | |
71 | (let ((port (open-output-file filename))) | |
72 | (display string port) | |
73 | (close-port port)) | |
74 | (let ((in-string (read-file filename))) | |
75 | (pass-if "file: write and read back characters" | |
76 | (equal? string in-string))) | |
77 | (delete-file filename)) | |
000ee07f | 78 | |
7c035009 | 79 | ;;; Buffered input/output port with seeking. |
57e7f270 DH |
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) | |
89 | (write-char #\x port) | |
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)) | |
8f99e3f3 | 96 | (close-port port) |
57e7f270 | 97 | (delete-file filename)) |
7c035009 GH |
98 | |
99 | ;;; Unbuffered input/output port with seeking. | |
57e7f270 DH |
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)) | |
8f99e3f3 | 116 | (close-port port) |
57e7f270 | 117 | (delete-file filename)) |
7c035009 | 118 | |
4fcd6551 | 119 | ;;; Buffered output-only and input-only ports with seeking. |
57e7f270 DH |
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) | |
127 | (close-port port) | |
128 | (let ((iport (open-input-file filename))) | |
129 | (pass-if "file: in tell 0" | |
130 | (= (seek iport 0 SEEK_CUR) 0)) | |
131 | (read-char iport) | |
132 | (pass-if "file: in tell 1" | |
133 | (= (seek iport 0 SEEK_CUR) 1)) | |
134 | (unread-char #\z iport) | |
135 | (pass-if "file: in tell 0 after unread" | |
136 | (= (seek iport 0 SEEK_CUR) 0)) | |
137 | (pass-if "file: unread char still there" | |
138 | (char=? (read-char iport) #\z)) | |
139 | (seek iport 7 SEEK_SET) | |
140 | (pass-if "file: in last char" | |
141 | (char=? (read-char iport) #\x)) | |
142 | (close-port iport)) | |
143 | (delete-file filename)) | |
4fcd6551 | 144 | |
7f214e60 | 145 | ;;; unusual characters. |
57e7f270 DH |
146 | (let* ((filename (test-file)) |
147 | (port (open-output-file filename))) | |
148 | (display (string #\nul (integer->char 255) (integer->char 128) | |
149 | #\nul) port) | |
150 | (close-port port) | |
151 | (let* ((port (open-input-file filename)) | |
152 | (line (read-line port))) | |
153 | (pass-if "file: read back NUL 1" | |
154 | (char=? (string-ref line 0) #\nul)) | |
155 | (pass-if "file: read back 255" | |
156 | (char=? (string-ref line 1) (integer->char 255))) | |
157 | (pass-if "file: read back 128" | |
158 | (char=? (string-ref line 2) (integer->char 128))) | |
159 | (pass-if "file: read back NUL 2" | |
160 | (char=? (string-ref line 3) #\nul)) | |
161 | (pass-if "file: EOF" | |
8f99e3f3 SJ |
162 | (eof-object? (read-char port))) |
163 | (close-port port)) | |
57e7f270 | 164 | (delete-file filename)) |
7f214e60 | 165 | |
0eb2e8cd | 166 | ;;; line buffering mode. |
57e7f270 DH |
167 | (let* ((filename (test-file)) |
168 | (port (open-file filename "wl")) | |
169 | (test-string "one line more or less")) | |
170 | (write-line test-string port) | |
171 | (let* ((in-port (open-input-file filename)) | |
172 | (line (read-line in-port))) | |
173 | (close-port in-port) | |
174 | (close-port port) | |
175 | (pass-if "file: line buffering" | |
176 | (string=? line test-string))) | |
177 | (delete-file filename)) | |
0eb2e8cd | 178 | |
d1b143e9 | 179 | ;;; ungetting characters and strings. |
57e7f270 DH |
180 | (with-input-from-string "walk on the moon\nmoon" |
181 | (lambda () | |
182 | (read-char) | |
183 | (unread-char #\a (current-input-port)) | |
184 | (pass-if "unread-char" | |
185 | (char=? (read-char) #\a)) | |
186 | (read-line) | |
187 | (let ((replacenoid "chicken enchilada")) | |
188 | (unread-char #\newline (current-input-port)) | |
189 | (unread-string replacenoid (current-input-port)) | |
190 | (pass-if "unread-string" | |
191 | (string=? (read-line) replacenoid))) | |
192 | (pass-if "unread residue" | |
193 | (string=? (read-line) "moon")))) | |
d1b143e9 | 194 | |
6e822cce | 195 | ;;; non-blocking mode on a port. create a pipe and set O_NONBLOCK on |
8cc58ec1 GH |
196 | ;;; the reading end. try to read a byte: should get EAGAIN or |
197 | ;;; EWOULDBLOCK error. | |
57e7f270 DH |
198 | (let* ((p (pipe)) |
199 | (r (car p))) | |
200 | (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK)) | |
201 | (pass-if "non-blocking-I/O" | |
202 | (catch 'system-error | |
203 | (lambda () (read-char r) #f) | |
204 | (lambda (key . args) | |
205 | (and (eq? key 'system-error) | |
206 | (let ((errno (car (list-ref args 3)))) | |
207 | (or (= errno EAGAIN) | |
208 | (= errno EWOULDBLOCK)))))))) | |
22d35615 | 209 | |
000ee07f | 210 | \f |
6e822cce | 211 | ;;;; Pipe (popen) ports. |
000ee07f JB |
212 | |
213 | ;;; Run a command, and read its output. | |
57e7f270 DH |
214 | (let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r")) |
215 | (in-string (read-all pipe))) | |
216 | (close-pipe pipe) | |
217 | (pass-if "pipe: read" | |
218 | (equal? in-string "Howdy there, partner!\n"))) | |
000ee07f JB |
219 | |
220 | ;;; Run a command, send some output to it, and see if it worked. | |
57e7f270 DH |
221 | (let* ((filename (test-file)) |
222 | (pipe (open-pipe (string-append "grep Mommy > " filename) "w"))) | |
223 | (display "Now Jimmy lives on a mushroom cloud\n" pipe) | |
224 | (display "Mommy, why does everybody have a bomb?\n" pipe) | |
225 | (close-pipe pipe) | |
226 | (let ((in-string (read-file filename))) | |
227 | (pass-if "pipe: write" | |
228 | (equal? in-string "Mommy, why does everybody have a bomb?\n"))) | |
229 | (delete-file filename)) | |
000ee07f JB |
230 | |
231 | \f | |
232 | ;;;; Void ports. These are so trivial we don't test them. | |
233 | ||
234 | \f | |
235 | ;;;; String ports. | |
236 | ||
73cb0a97 JB |
237 | (with-test-prefix "string ports" |
238 | ||
239 | ;; Write text to a string port. | |
57e7f270 DH |
240 | (let* ((string "Howdy there, partner!") |
241 | (in-string (call-with-output-string | |
242 | (lambda (port) | |
243 | (display string port) | |
244 | (newline port))))) | |
245 | (pass-if "display text" | |
246 | (equal? in-string (string-append string "\n")))) | |
000ee07f | 247 | |
73cb0a97 | 248 | ;; Write an s-expression to a string port. |
57e7f270 DH |
249 | (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926)) |
250 | (in-sexpr | |
251 | (call-with-input-string (call-with-output-string | |
252 | (lambda (port) | |
253 | (write sexpr port))) | |
254 | read))) | |
255 | (pass-if "write/read sexpr" | |
256 | (equal? in-sexpr sexpr))) | |
2d9e5bca GH |
257 | |
258 | ;; seeking and unreading from an input string. | |
57e7f270 DH |
259 | (let ((text "that text didn't look random to me")) |
260 | (call-with-input-string text | |
261 | (lambda (p) | |
262 | (pass-if "input tell 0" | |
263 | (= (seek p 0 SEEK_CUR) 0)) | |
264 | (read-char p) | |
265 | (pass-if "input tell 1" | |
266 | (= (seek p 0 SEEK_CUR) 1)) | |
267 | (unread-char #\x p) | |
268 | (pass-if "input tell back to 0" | |
269 | (= (seek p 0 SEEK_CUR) 0)) | |
270 | (pass-if "input ungetted char" | |
271 | (char=? (read-char p) #\x)) | |
272 | (seek p 0 SEEK_END) | |
273 | (pass-if "input seek to end" | |
274 | (= (seek p 0 SEEK_CUR) | |
275 | (string-length text))) | |
276 | (unread-char #\x p) | |
277 | (pass-if "input seek to beginning" | |
278 | (= (seek p 0 SEEK_SET) 0)) | |
279 | (pass-if "input reread first char" | |
280 | (char=? (read-char p) | |
281 | (string-ref text 0)))))) | |
282 | ||
2d9e5bca | 283 | ;; seeking an output string. |
e4cbd1d8 | 284 | (let* ((text (string-copy "123456789")) |
57e7f270 DH |
285 | (len (string-length text)) |
286 | (result (call-with-output-string | |
287 | (lambda (p) | |
288 | (pass-if "output tell 0" | |
289 | (= (seek p 0 SEEK_CUR) 0)) | |
290 | (display text p) | |
291 | (pass-if "output tell end" | |
292 | (= (seek p 0 SEEK_CUR) len)) | |
293 | (pass-if "output seek to beginning" | |
294 | (= (seek p 0 SEEK_SET) 0)) | |
295 | (write-char #\a p) | |
296 | (seek p -1 SEEK_END) | |
297 | (pass-if "output seek to last char" | |
298 | (= (seek p 0 SEEK_CUR) | |
299 | (- len 1))) | |
300 | (write-char #\b p))))) | |
301 | (string-set! text 0 #\a) | |
302 | (string-set! text (- len 1) #\b) | |
303 | (pass-if "output check" | |
304 | (string=? text result)))) | |
2d9e5bca | 305 | |
ee6eedcd KR |
306 | (with-test-prefix "call-with-output-string" |
307 | ||
308 | ;; In Guile 1.6.4, closing the port resulted in a segv, check that doesn't | |
309 | ;; occur. | |
310 | (pass-if-exception "proc closes port" exception:wrong-type-arg | |
311 | (call-with-output-string close-port))) | |
312 | ||
000ee07f JB |
313 | |
314 | \f | |
315 | ;;;; Soft ports. No tests implemented yet. | |
316 | ||
317 | \f | |
318 | ;;;; Generic operations across all port types. | |
319 | ||
320 | (let ((port-loop-temp (test-file))) | |
321 | ||
322 | ;; Return a list of input ports that all return the same text. | |
323 | ;; We map tests over this list. | |
324 | (define (input-port-list text) | |
325 | ||
326 | ;; Create a text file some of the ports will use. | |
327 | (let ((out-port (open-output-file port-loop-temp))) | |
328 | (display text out-port) | |
329 | (close-port out-port)) | |
330 | ||
331 | (list (open-input-file port-loop-temp) | |
332 | (open-input-pipe (string-append "cat " port-loop-temp)) | |
333 | (call-with-input-string text (lambda (x) x)) | |
334 | ;; We don't test soft ports at the moment. | |
335 | )) | |
336 | ||
337 | (define port-list-names '("file" "pipe" "string")) | |
338 | ||
339 | ;; Test the line counter. | |
73cb0a97 | 340 | (define (test-line-counter text second-line final-column) |
000ee07f JB |
341 | (with-test-prefix "line counter" |
342 | (let ((ports (input-port-list text))) | |
343 | (for-each | |
344 | (lambda (port port-name) | |
345 | (with-test-prefix port-name | |
346 | (pass-if "at beginning of input" | |
347 | (= (port-line port) 0)) | |
348 | (pass-if "read first character" | |
349 | (eqv? (read-char port) #\x)) | |
350 | (pass-if "after reading one character" | |
351 | (= (port-line port) 0)) | |
352 | (pass-if "read first newline" | |
353 | (eqv? (read-char port) #\newline)) | |
354 | (pass-if "after reading first newline char" | |
355 | (= (port-line port) 1)) | |
356 | (pass-if "second line read correctly" | |
357 | (equal? (read-line port) second-line)) | |
358 | (pass-if "read-line increments line number" | |
359 | (= (port-line port) 2)) | |
0b8faa0e JB |
360 | (pass-if "read-line returns EOF" |
361 | (let loop ((i 0)) | |
362 | (cond | |
363 | ((eof-object? (read-line port)) #t) | |
364 | ((> i 20) #f) | |
365 | (else (loop (+ i 1)))))) | |
000ee07f | 366 | (pass-if "line count is 5 at EOF" |
73cb0a97 JB |
367 | (= (port-line port) 5)) |
368 | (pass-if "column is correct at EOF" | |
369 | (= (port-column port) final-column)))) | |
000ee07f JB |
370 | ports port-list-names) |
371 | (for-each close-port ports) | |
372 | (delete-file port-loop-temp)))) | |
373 | ||
57e7f270 DH |
374 | (with-test-prefix "newline" |
375 | (test-line-counter | |
376 | (string-append "x\n" | |
377 | "He who receives an idea from me, receives instruction\n" | |
378 | "himself without lessening mine; as he who lights his\n" | |
379 | "taper at mine, receives light without darkening me.\n" | |
380 | " --- Thomas Jefferson\n") | |
381 | "He who receives an idea from me, receives instruction" | |
382 | 0)) | |
383 | ||
384 | (with-test-prefix "no newline" | |
385 | (test-line-counter | |
386 | (string-append "x\n" | |
387 | "He who receives an idea from me, receives instruction\n" | |
388 | "himself without lessening mine; as he who lights his\n" | |
389 | "taper at mine, receives light without darkening me.\n" | |
390 | " --- Thomas Jefferson\n" | |
391 | "no newline here") | |
392 | "He who receives an idea from me, receives instruction" | |
393 | 15))) | |
5bc1201f | 394 | |
9a8be5a7 MV |
395 | ;; Test port-line and port-column for output ports |
396 | ||
397 | (define (test-output-line-counter text final-column) | |
398 | (with-test-prefix "port-line and port-column for output ports" | |
399 | (let ((port (open-output-string))) | |
400 | (pass-if "at beginning of input" | |
401 | (and (= (port-line port) 0) | |
402 | (= (port-column port) 0))) | |
403 | (write-char #\x port) | |
404 | (pass-if "after writing one character" | |
405 | (and (= (port-line port) 0) | |
406 | (= (port-column port) 1))) | |
407 | (write-char #\newline port) | |
408 | (pass-if "after writing first newline char" | |
409 | (and (= (port-line port) 1) | |
410 | (= (port-column port) 0))) | |
411 | (display text port) | |
412 | (pass-if "line count is 5 at end" | |
413 | (= (port-line port) 5)) | |
414 | (pass-if "column is correct at end" | |
415 | (= (port-column port) final-column))))) | |
416 | ||
417 | (test-output-line-counter | |
418 | (string-append "He who receives an idea from me, receives instruction\n" | |
419 | "himself without lessening mine; as he who lights his\n" | |
420 | "taper at mine, receives light without darkening me.\n" | |
421 | " --- Thomas Jefferson\n" | |
422 | "no newline here") | |
423 | 15) | |
424 | ||
7424deab KR |
425 | (with-test-prefix "port-column" |
426 | ||
427 | (with-test-prefix "output" | |
428 | ||
429 | (pass-if "x" | |
430 | (let ((port (open-output-string))) | |
431 | (display "x" port) | |
432 | (= 1 (port-column port)))) | |
433 | ||
434 | (pass-if "\\a" | |
435 | (let ((port (open-output-string))) | |
436 | (display "\a" port) | |
437 | (= 0 (port-column port)))) | |
438 | ||
439 | (pass-if "x\\a" | |
440 | (let ((port (open-output-string))) | |
441 | (display "x\a" port) | |
442 | (= 1 (port-column port)))) | |
443 | ||
444 | (pass-if "\\x08 backspace" | |
445 | (let ((port (open-output-string))) | |
446 | (display "\x08" port) | |
447 | (= 0 (port-column port)))) | |
448 | ||
449 | (pass-if "x\\x08 backspace" | |
450 | (let ((port (open-output-string))) | |
451 | (display "x\x08" port) | |
452 | (= 0 (port-column port)))) | |
453 | ||
454 | (pass-if "\\n" | |
455 | (let ((port (open-output-string))) | |
456 | (display "\n" port) | |
457 | (= 0 (port-column port)))) | |
458 | ||
459 | (pass-if "x\\n" | |
460 | (let ((port (open-output-string))) | |
461 | (display "x\n" port) | |
462 | (= 0 (port-column port)))) | |
463 | ||
464 | (pass-if "\\r" | |
465 | (let ((port (open-output-string))) | |
466 | (display "\r" port) | |
467 | (= 0 (port-column port)))) | |
468 | ||
469 | (pass-if "x\\r" | |
470 | (let ((port (open-output-string))) | |
471 | (display "x\r" port) | |
472 | (= 0 (port-column port)))) | |
473 | ||
474 | (pass-if "\\t" | |
475 | (let ((port (open-output-string))) | |
476 | (display "\t" port) | |
477 | (= 8 (port-column port)))) | |
478 | ||
479 | (pass-if "x\\t" | |
480 | (let ((port (open-output-string))) | |
481 | (display "x\t" port) | |
482 | (= 8 (port-column port))))) | |
483 | ||
484 | (with-test-prefix "input" | |
485 | ||
486 | (pass-if "x" | |
487 | (let ((port (open-input-string "x"))) | |
488 | (while (not (eof-object? (read-char port)))) | |
489 | (= 1 (port-column port)))) | |
490 | ||
491 | (pass-if "\\a" | |
492 | (let ((port (open-input-string "\a"))) | |
493 | (while (not (eof-object? (read-char port)))) | |
494 | (= 0 (port-column port)))) | |
495 | ||
496 | (pass-if "x\\a" | |
497 | (let ((port (open-input-string "x\a"))) | |
498 | (while (not (eof-object? (read-char port)))) | |
499 | (= 1 (port-column port)))) | |
500 | ||
501 | (pass-if "\\x08 backspace" | |
502 | (let ((port (open-input-string "\x08"))) | |
503 | (while (not (eof-object? (read-char port)))) | |
504 | (= 0 (port-column port)))) | |
505 | ||
506 | (pass-if "x\\x08 backspace" | |
507 | (let ((port (open-input-string "x\x08"))) | |
508 | (while (not (eof-object? (read-char port)))) | |
509 | (= 0 (port-column port)))) | |
510 | ||
511 | (pass-if "\\n" | |
512 | (let ((port (open-input-string "\n"))) | |
513 | (while (not (eof-object? (read-char port)))) | |
514 | (= 0 (port-column port)))) | |
515 | ||
516 | (pass-if "x\\n" | |
517 | (let ((port (open-input-string "x\n"))) | |
518 | (while (not (eof-object? (read-char port)))) | |
519 | (= 0 (port-column port)))) | |
520 | ||
521 | (pass-if "\\r" | |
522 | (let ((port (open-input-string "\r"))) | |
523 | (while (not (eof-object? (read-char port)))) | |
524 | (= 0 (port-column port)))) | |
525 | ||
526 | (pass-if "x\\r" | |
527 | (let ((port (open-input-string "x\r"))) | |
528 | (while (not (eof-object? (read-char port)))) | |
529 | (= 0 (port-column port)))) | |
530 | ||
531 | (pass-if "\\t" | |
532 | (let ((port (open-input-string "\t"))) | |
533 | (while (not (eof-object? (read-char port)))) | |
534 | (= 8 (port-column port)))) | |
535 | ||
536 | (pass-if "x\\t" | |
537 | (let ((port (open-input-string "x\t"))) | |
538 | (while (not (eof-object? (read-char port)))) | |
539 | (= 8 (port-column port)))))) | |
540 | ||
8ab3d8a0 KR |
541 | ;;; |
542 | ;;; seek | |
543 | ;;; | |
544 | ||
545 | (with-test-prefix "seek" | |
546 | ||
547 | (with-test-prefix "file port" | |
548 | ||
549 | (pass-if "SEEK_CUR" | |
550 | (call-with-output-file (test-file) | |
551 | (lambda (port) | |
552 | (display "abcde" port))) | |
553 | (let ((port (open-file (test-file) "r"))) | |
554 | (read-char port) | |
555 | (seek port 2 SEEK_CUR) | |
556 | (eqv? #\d (read-char port)))) | |
557 | ||
558 | (pass-if "SEEK_SET" | |
559 | (call-with-output-file (test-file) | |
560 | (lambda (port) | |
561 | (display "abcde" port))) | |
562 | (let ((port (open-file (test-file) "r"))) | |
563 | (read-char port) | |
564 | (seek port 3 SEEK_SET) | |
565 | (eqv? #\d (read-char port)))) | |
566 | ||
567 | (pass-if "SEEK_END" | |
568 | (call-with-output-file (test-file) | |
569 | (lambda (port) | |
570 | (display "abcde" port))) | |
571 | (let ((port (open-file (test-file) "r"))) | |
572 | (read-char port) | |
573 | (seek port -2 SEEK_END) | |
574 | (eqv? #\d (read-char port)))))) | |
575 | ||
6e7d5622 KR |
576 | ;;; |
577 | ;;; truncate-file | |
578 | ;;; | |
579 | ||
580 | (with-test-prefix "truncate-file" | |
581 | ||
8ab3d8a0 KR |
582 | (pass-if-exception "flonum file" exception:wrong-type-arg |
583 | (truncate-file 1.0 123)) | |
584 | ||
585 | (pass-if-exception "frac file" exception:wrong-type-arg | |
586 | (truncate-file 7/3 123)) | |
587 | ||
6e7d5622 KR |
588 | (with-test-prefix "filename" |
589 | ||
8ab3d8a0 KR |
590 | (pass-if-exception "flonum length" exception:wrong-type-arg |
591 | (call-with-output-file (test-file) | |
592 | (lambda (port) | |
593 | (display "hello" port))) | |
594 | (truncate-file (test-file) 1.0)) | |
595 | ||
6e7d5622 KR |
596 | (pass-if "shorten" |
597 | (call-with-output-file (test-file) | |
598 | (lambda (port) | |
599 | (display "hello" port))) | |
600 | (truncate-file (test-file) 1) | |
8ab3d8a0 KR |
601 | (eqv? 1 (stat:size (stat (test-file))))) |
602 | ||
603 | (pass-if-exception "shorten to current pos" exception:miscellaneous-error | |
604 | (call-with-output-file (test-file) | |
605 | (lambda (port) | |
606 | (display "hello" port))) | |
607 | (truncate-file (test-file)))) | |
6e7d5622 KR |
608 | |
609 | (with-test-prefix "file descriptor" | |
610 | ||
611 | (pass-if "shorten" | |
612 | (call-with-output-file (test-file) | |
613 | (lambda (port) | |
614 | (display "hello" port))) | |
615 | (let ((fd (open-fdes (test-file) O_RDWR))) | |
616 | (truncate-file fd 1) | |
617 | (close-fdes fd)) | |
8ab3d8a0 KR |
618 | (eqv? 1 (stat:size (stat (test-file))))) |
619 | ||
620 | (pass-if "shorten to current pos" | |
621 | (call-with-output-file (test-file) | |
622 | (lambda (port) | |
623 | (display "hello" port))) | |
624 | (let ((fd (open-fdes (test-file) O_RDWR))) | |
625 | (seek fd 1 SEEK_SET) | |
626 | (truncate-file fd) | |
627 | (close-fdes fd)) | |
6e7d5622 KR |
628 | (eqv? 1 (stat:size (stat (test-file)))))) |
629 | ||
630 | (with-test-prefix "file port" | |
631 | ||
632 | (pass-if "shorten" | |
633 | (call-with-output-file (test-file) | |
634 | (lambda (port) | |
635 | (display "hello" port))) | |
636 | (let ((port (open-file (test-file) "r+"))) | |
637 | (truncate-file port 1)) | |
8ab3d8a0 KR |
638 | (eqv? 1 (stat:size (stat (test-file))))) |
639 | ||
640 | (pass-if "shorten to current pos" | |
641 | (call-with-output-file (test-file) | |
642 | (lambda (port) | |
643 | (display "hello" port))) | |
644 | (let ((port (open-file (test-file) "r+"))) | |
645 | (read-char port) | |
646 | (truncate-file port)) | |
6e7d5622 KR |
647 | (eqv? 1 (stat:size (stat (test-file))))))) |
648 | ||
7424deab | 649 | |
5bc1201f JB |
650 | ;;;; testing read-delimited and friends |
651 | ||
652 | (with-test-prefix "read-delimited!" | |
653 | (let ((c (make-string 20 #\!))) | |
654 | (call-with-input-string | |
655 | "defdef\nghighi\n" | |
656 | (lambda (port) | |
657 | ||
658 | (read-delimited! "\n" c port 'concat) | |
659 | (pass-if "read-delimited! reads a first line" | |
660 | (string=? c "defdef\n!!!!!!!!!!!!!")) | |
661 | ||
662 | (read-delimited! "\n" c port 'concat 3) | |
663 | (pass-if "read-delimited! reads a first line" | |
664 | (string=? c "defghighi\n!!!!!!!!!!")))))) | |
1b054952 JB |
665 | |
666 | \f | |
667 | ;;;; char-ready? | |
668 | ||
669 | (call-with-input-string | |
670 | "howdy" | |
671 | (lambda (port) | |
672 | (pass-if "char-ready? returns true on string port" | |
673 | (char-ready? port)))) | |
674 | ||
675 | ;;; This segfaults on some versions of Guile. We really should run | |
676 | ;;; the tests in a subprocess... | |
677 | ||
678 | (call-with-input-string | |
679 | "howdy" | |
680 | (lambda (port) | |
681 | (with-input-from-port | |
682 | port | |
683 | (lambda () | |
684 | (pass-if "char-ready? returns true on string port as default port" | |
685 | (char-ready?)))))) | |
fe5b6beb JB |
686 | |
687 | \f | |
688 | ;;;; Close current-input-port, and make sure everyone can handle it. | |
689 | ||
690 | (with-test-prefix "closing current-input-port" | |
691 | (for-each (lambda (procedure name) | |
692 | (with-input-from-port | |
693 | (call-with-input-string "foo" (lambda (p) p)) | |
694 | (lambda () | |
695 | (close-port (current-input-port)) | |
6b4113af DH |
696 | (pass-if-exception name |
697 | exception:wrong-type-arg | |
698 | (procedure))))) | |
fe5b6beb JB |
699 | (list read read-char read-line) |
700 | '("read" "read-char" "read-line"))) | |
c56c0f79 MV |
701 | |
702 | (delete-file (test-file)) |