Make sure binary ports pass `binary-port?' regardless of the locale.
[bpt/guile.git] / test-suite / tests / r6rs-ports.test
CommitLineData
8aa47f26 1;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
1ee2c72e 2;;;;
b04f841d 3;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
8aa47f26 4;;;; Ludovic Courtès
1ee2c72e
LC
5;;;;
6;;;; This library is free software; you can redistribute it and/or
7;;;; modify it under the terms of the GNU Lesser General Public
8;;;; License as published by the Free Software Foundation; either
53befeb7
NJ
9;;;; version 3 of the License, or (at your option) any later version.
10;;;;
1ee2c72e
LC
11;;;; This library 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 GNU
14;;;; Lesser General Public License for more details.
53befeb7 15;;;;
1ee2c72e
LC
16;;;; You should have received a copy of the GNU Lesser General Public
17;;;; License along with this library; if not, write to the Free Software
18;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19
20(define-module (test-io-ports)
d4b81637
LC
21 #:use-module (test-suite lib)
22 #:use-module (srfi srfi-1)
23 #:use-module (srfi srfi-11)
24 #:use-module (rnrs io ports)
b1e76e8f 25 #:use-module (rnrs exceptions)
d4b81637 26 #:use-module (rnrs bytevectors))
1ee2c72e
LC
27
28;;; All these tests assume Guile 1.8's port system, where characters are
29;;; treated as octets.
30
d6a6989e
LC
31;; Set the default encoding of future ports to be Latin-1.
32(fluid-set! %default-port-encoding #f)
889975e5 33
1ee2c72e
LC
34\f
35(with-test-prefix "7.2.5 End-of-File Object"
36
37 (pass-if "eof-object"
38 (and (eqv? (eof-object) (eof-object))
b04f841d
AW
39 (eq? (eof-object) (eof-object))))
40
41 (pass-if "port-eof?"
42 (port-eof? (open-input-string ""))))
1ee2c72e
LC
43
44\f
45(with-test-prefix "7.2.8 Binary Input"
46
47 (pass-if "get-u8"
48 (let ((port (open-input-string "A")))
49 (and (= (char->integer #\A) (get-u8 port))
50 (eof-object? (get-u8 port)))))
51
52 (pass-if "lookahead-u8"
53 (let ((port (open-input-string "A")))
54 (and (= (char->integer #\A) (lookahead-u8 port))
8aa47f26 55 (= (char->integer #\A) (lookahead-u8 port))
1ee2c72e
LC
56 (= (char->integer #\A) (get-u8 port))
57 (eof-object? (get-u8 port)))))
58
8aa47f26
LC
59 (pass-if "lookahead-u8 non-ASCII"
60 (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
61 (open-input-string "λ"))))
62 (and (= 206 (lookahead-u8 port))
63 (= 206 (lookahead-u8 port))
64 (= 206 (get-u8 port))
65 (= 187 (lookahead-u8 port))
66 (= 187 (lookahead-u8 port))
67 (= 187 (get-u8 port))
68 (eof-object? (lookahead-u8 port))
69 (eof-object? (get-u8 port)))))
70
3fa88220
LC
71 (pass-if "lookahead-u8: result is unsigned"
72 ;; Bug #31081.
73 (let ((port (open-bytevector-input-port #vu8(255))))
74 (= (lookahead-u8 port) 255)))
75
1ee2c72e
LC
76 (pass-if "get-bytevector-n [short]"
77 (let* ((port (open-input-string "GNU Guile"))
78 (bv (get-bytevector-n port 4)))
79 (and (bytevector? bv)
80 (equal? (bytevector->u8-list bv)
81 (map char->integer (string->list "GNU "))))))
82
83 (pass-if "get-bytevector-n [long]"
84 (let* ((port (open-input-string "GNU Guile"))
85 (bv (get-bytevector-n port 256)))
86 (and (bytevector? bv)
87 (equal? (bytevector->u8-list bv)
88 (map char->integer (string->list "GNU Guile"))))))
89
90 (pass-if-exception "get-bytevector-n with closed port"
91 exception:wrong-type-arg
92
93 (let ((port (%make-void-port "r")))
94
95 (close-port port)
96 (get-bytevector-n port 3)))
97
98 (pass-if "get-bytevector-n! [short]"
99 (let* ((port (open-input-string "GNU Guile"))
100 (bv (make-bytevector 4))
101 (read (get-bytevector-n! port bv 0 4)))
102 (and (equal? read 4)
103 (equal? (bytevector->u8-list bv)
104 (map char->integer (string->list "GNU "))))))
105
106 (pass-if "get-bytevector-n! [long]"
107 (let* ((str "GNU Guile")
108 (port (open-input-string str))
109 (bv (make-bytevector 256))
110 (read (get-bytevector-n! port bv 0 256)))
111 (and (equal? read (string-length str))
112 (equal? (map (lambda (i)
113 (bytevector-u8-ref bv i))
114 (iota read))
115 (map char->integer (string->list str))))))
116
117 (pass-if "get-bytevector-some [simple]"
118 (let* ((str "GNU Guile")
119 (port (open-input-string str))
120 (bv (get-bytevector-some port)))
121 (and (bytevector? bv)
122 (equal? (bytevector->u8-list bv)
123 (map char->integer (string->list str))))))
124
125 (pass-if "get-bytevector-some [only-some]"
126 (let* ((str "GNU Guile")
127 (index 0)
128 (port (make-soft-port
129 (vector #f #f #f
130 (lambda ()
131 (if (>= index (string-length str))
132 (eof-object)
133 (let ((c (string-ref str index)))
134 (set! index (+ index 1))
135 c)))
136 (lambda () #t)
137 (lambda ()
138 ;; Number of readily available octets: falls to
139 ;; zero after 4 octets have been read.
140 (- 4 (modulo index 5))))
141 "r"))
142 (bv (get-bytevector-some port)))
143 (and (bytevector? bv)
144 (= index 4)
145 (= (bytevector-length bv) index)
146 (equal? (bytevector->u8-list bv)
147 (map char->integer (string->list "GNU "))))))
148
149 (pass-if "get-bytevector-all"
150 (let* ((str "GNU Guile")
151 (index 0)
152 (port (make-soft-port
153 (vector #f #f #f
154 (lambda ()
155 (if (>= index (string-length str))
156 (eof-object)
157 (let ((c (string-ref str index)))
158 (set! index (+ index 1))
159 c)))
160 (lambda () #t)
161 (let ((cont? #f))
162 (lambda ()
163 ;; Number of readily available octets: falls to
164 ;; zero after 4 octets have been read and then
165 ;; starts again.
166 (let ((a (if cont?
167 (- (string-length str) index)
168 (- 4 (modulo index 5)))))
169 (if (= 0 a) (set! cont? #t))
170 a))))
171 "r"))
172 (bv (get-bytevector-all port)))
173 (and (bytevector? bv)
174 (= index (string-length str))
175 (= (bytevector-length bv) (string-length str))
176 (equal? (bytevector->u8-list bv)
177 (map char->integer (string->list str)))))))
178
179\f
180(define (make-soft-output-port)
181 (let* ((bv (make-bytevector 1024))
182 (read-index 0)
183 (write-index 0)
184 (write-char (lambda (chr)
185 (bytevector-u8-set! bv write-index
186 (char->integer chr))
187 (set! write-index (+ 1 write-index)))))
188 (make-soft-port
189 (vector write-char
190 (lambda (str) ;; write-string
191 (for-each write-char (string->list str)))
192 (lambda () #t) ;; flush-output
193 (lambda () ;; read-char
194 (if (>= read-index (bytevector-length bv))
195 (eof-object)
196 (let ((c (bytevector-u8-ref bv read-index)))
197 (set! read-index (+ read-index 1))
198 (integer->char c))))
199 (lambda () #t)) ;; close-port
200 "rw")))
201
202(with-test-prefix "7.2.11 Binary Output"
203
204 (pass-if "put-u8"
205 (let ((port (make-soft-output-port)))
206 (put-u8 port 77)
207 (equal? (get-u8 port) 77)))
208
bf08e10f
LC
209 ;; Note: The `put-bytevector' tests below require a Latin-1 locale so
210 ;; that the `scm_from_locale_stringn' call in `sf_write' will let all
211 ;; the bytes through, unmodified. This is hacky, but we can't use
212 ;; "custom binary output ports" here because they're only tested
213 ;; later.
214
1ee2c72e 215 (pass-if "put-bytevector [2 args]"
bf08e10f
LC
216 (with-latin1-locale
217 (let ((port (make-soft-output-port))
218 (bv (make-bytevector 256)))
219 (put-bytevector port bv)
220 (equal? (bytevector->u8-list bv)
221 (bytevector->u8-list
222 (get-bytevector-n port (bytevector-length bv)))))))
1ee2c72e
LC
223
224 (pass-if "put-bytevector [3 args]"
bf08e10f
LC
225 (with-latin1-locale
226 (let ((port (make-soft-output-port))
227 (bv (make-bytevector 256))
228 (start 10))
229 (put-bytevector port bv start)
230 (equal? (drop (bytevector->u8-list bv) start)
231 (bytevector->u8-list
232 (get-bytevector-n port (- (bytevector-length bv) start)))))))
1ee2c72e
LC
233
234 (pass-if "put-bytevector [4 args]"
bf08e10f
LC
235 (with-latin1-locale
236 (let ((port (make-soft-output-port))
237 (bv (make-bytevector 256))
238 (start 10)
239 (count 77))
240 (put-bytevector port bv start count)
241 (equal? (take (drop (bytevector->u8-list bv) start) count)
242 (bytevector->u8-list
243 (get-bytevector-n port count))))))
1ee2c72e
LC
244
245 (pass-if-exception "put-bytevector with closed port"
246 exception:wrong-type-arg
247
248 (let* ((bv (make-bytevector 4))
249 (port (%make-void-port "w")))
250
251 (close-port port)
7b041912
LC
252 (put-bytevector port bv)))
253
254 (pass-if "put-bytevector with UTF-16 string port"
255 (let* ((str "hello, world")
256 (bv (string->utf16 str)))
257 (equal? str
258 (with-fluids ((%default-port-encoding "UTF-16BE"))
259 (call-with-output-string
260 (lambda (port)
261 (put-bytevector port bv)))))))
262
ef7e4ba3 263 (pass-if "put-bytevector with wrong-encoding string port"
7b041912
LC
264 (let* ((str "hello, world")
265 (bv (string->utf16 str)))
c62da8f8 266 (catch 'decoding-error
ef7e4ba3
LC
267 (lambda ()
268 (with-fluids ((%default-port-encoding "UTF-32"))
269 (call-with-output-string
270 (lambda (port)
271 (put-bytevector port bv)))))
c62da8f8
LC
272 (lambda (key subr message errno port)
273 (string? (strerror errno)))))))
1ee2c72e
LC
274
275\f
276(with-test-prefix "7.2.7 Input Ports"
277
278 ;; This section appears here so that it can use the binary input
279 ;; primitives.
280
281 (pass-if "open-bytevector-input-port [1 arg]"
282 (let* ((str "Hello Port!")
283 (bv (u8-list->bytevector (map char->integer
284 (string->list str))))
285 (port (open-bytevector-input-port bv))
286 (read-to-string
287 (lambda (port)
288 (let loop ((chr (read-char port))
289 (result '()))
290 (if (eof-object? chr)
291 (apply string (reverse! result))
292 (loop (read-char port)
293 (cons chr result)))))))
294
295 (equal? (read-to-string port) str)))
296
96128014
LC
297 (pass-if "bytevector-input-port is binary"
298 (with-fluids ((%default-port-encoding "UTF-8"))
299 (binary-port? (open-bytevector-input-port #vu8(1 2 3)))))
300
1ee2c72e
LC
301 (pass-if-exception "bytevector-input-port is read-only"
302 exception:wrong-type-arg
303
304 (let* ((str "Hello Port!")
305 (bv (u8-list->bytevector (map char->integer
306 (string->list str))))
307 (port (open-bytevector-input-port bv #f)))
308
309 (write "hello" port)))
310
311 (pass-if "bytevector input port supports seeking"
312 (let* ((str "Hello Port!")
313 (bv (u8-list->bytevector (map char->integer
314 (string->list str))))
315 (port (open-bytevector-input-port bv #f)))
316
317 (and (port-has-port-position? port)
318 (= 0 (port-position port))
319 (port-has-set-port-position!? port)
320 (begin
321 (set-port-position! port 6)
322 (= 6 (port-position port)))
323 (bytevector=? (get-bytevector-all port)
324 (u8-list->bytevector
325 (map char->integer (string->list "Port!")))))))
326
c89b4529
IP
327 (pass-if "bytevector input port can seek to very end"
328 (let ((empty (open-bytevector-input-port '#vu8()))
329 (not-empty (open-bytevector-input-port '#vu8(1 2 3))))
330 (and (begin (set-port-position! empty (port-position empty))
331 (= 0 (port-position empty)))
332 (begin (get-bytevector-n not-empty 3)
333 (set-port-position! not-empty (port-position not-empty))
334 (= 3 (port-position not-empty))))))
335
1ee2c72e
LC
336 (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
337 exception:wrong-num-args
338
339 ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
340 ;; optional.
341 (make-custom-binary-input-port "port" (lambda args #t)))
342
343 (pass-if "make-custom-binary-input-port"
344 (let* ((source (make-bytevector 7777))
345 (read! (let ((pos 0)
346 (len (bytevector-length source)))
347 (lambda (bv start count)
348 (let ((amount (min count (- len pos))))
349 (if (> amount 0)
350 (bytevector-copy! source pos
351 bv start amount))
352 (set! pos (+ pos amount))
353 amount))))
354 (port (make-custom-binary-input-port "the port" read!
355 #f #f #f)))
356
96128014
LC
357 (and (binary-port? port)
358 (input-port? port)
359 (bytevector=? (get-bytevector-all port) source))))
1ee2c72e
LC
360
361 (pass-if "custom binary input port does not support `port-position'"
362 (let* ((str "Hello Port!")
363 (source (open-bytevector-input-port
364 (u8-list->bytevector
365 (map char->integer (string->list str)))))
366 (read! (lambda (bv start count)
367 (let ((r (get-bytevector-n! source bv start count)))
368 (if (eof-object? r)
369 0
370 r))))
371 (port (make-custom-binary-input-port "the port" read!
372 #f #f #f)))
373 (not (or (port-has-port-position? port)
374 (port-has-set-port-position!? port)))))
375
376 (pass-if "custom binary input port supports `port-position'"
377 (let* ((str "Hello Port!")
378 (source (open-bytevector-input-port
379 (u8-list->bytevector
380 (map char->integer (string->list str)))))
381 (read! (lambda (bv start count)
382 (let ((r (get-bytevector-n! source bv start count)))
383 (if (eof-object? r)
384 0
385 r))))
386 (get-pos (lambda ()
387 (port-position source)))
388 (set-pos! (lambda (pos)
389 (set-port-position! source pos)))
390 (port (make-custom-binary-input-port "the port" read!
391 get-pos set-pos! #f)))
392
393 (and (port-has-port-position? port)
394 (= 0 (port-position port))
395 (port-has-set-port-position!? port)
396 (begin
397 (set-port-position! port 6)
398 (= 6 (port-position port)))
399 (bytevector=? (get-bytevector-all port)
400 (u8-list->bytevector
401 (map char->integer (string->list "Port!")))))))
402
403 (pass-if "custom binary input port `close-proc' is called"
404 (let* ((closed? #f)
405 (read! (lambda (bv start count) 0))
406 (get-pos (lambda () 0))
407 (set-pos! (lambda (pos) #f))
408 (close! (lambda () (set! closed? #t)))
409 (port (make-custom-binary-input-port "the port" read!
410 get-pos set-pos!
411 close!)))
412
413 (close-port port)
4574ec21 414 (gc) ; Test for marking a closed port.
ead04a04
AR
415 closed?))
416
417 (pass-if "standard-input-port is binary"
418 (with-fluids ((%default-port-encoding "UTF-8"))
419 (binary-port? (standard-input-port)))))
1ee2c72e
LC
420
421\f
422(with-test-prefix "8.2.10 Output ports"
423
424 (pass-if "open-bytevector-output-port"
425 (let-values (((port get-content)
426 (open-bytevector-output-port #f)))
427 (let ((source (make-bytevector 7777)))
428 (put-bytevector port source)
429 (and (bytevector=? (get-content) source)
430 (bytevector=? (get-content) (make-bytevector 0))))))
96128014
LC
431
432 (pass-if "bytevector-output-port is binary"
433 (binary-port? (open-bytevector-output-port)))
434
a653d32a
AR
435 (pass-if "open-bytevector-output-port [extract after close]"
436 (let-values (((port get-content)
437 (open-bytevector-output-port)))
438 (let ((source (make-bytevector 12345 #xFE)))
439 (put-bytevector port source)
440 (close-port port)
441 (bytevector=? (get-content) source))))
1ee2c72e
LC
442
443 (pass-if "open-bytevector-output-port [put-u8]"
444 (let-values (((port get-content)
445 (open-bytevector-output-port)))
446 (put-u8 port 77)
447 (and (bytevector=? (get-content) (make-bytevector 1 77))
448 (bytevector=? (get-content) (make-bytevector 0)))))
449
450 (pass-if "open-bytevector-output-port [display]"
451 (let-values (((port get-content)
452 (open-bytevector-output-port)))
453 (display "hello" port)
454 (and (bytevector=? (get-content) (string->utf8 "hello"))
455 (bytevector=? (get-content) (make-bytevector 0)))))
456
457 (pass-if "bytevector output port supports `port-position'"
458 (let-values (((port get-content)
459 (open-bytevector-output-port)))
460 (let ((source (make-bytevector 7777))
461 (overwrite (make-bytevector 33)))
462 (and (port-has-port-position? port)
463 (port-has-set-port-position!? port)
464 (begin
465 (put-bytevector port source)
466 (= (bytevector-length source)
467 (port-position port)))
468 (begin
469 (set-port-position! port 10)
470 (= 10 (port-position port)))
471 (begin
472 (put-bytevector port overwrite)
473 (bytevector-copy! overwrite 0 source 10
474 (bytevector-length overwrite))
475 (= (port-position port)
476 (+ 10 (bytevector-length overwrite))))
477 (bytevector=? (get-content) source)
478 (bytevector=? (get-content) (make-bytevector 0))))))
479
96128014 480 (pass-if "make-custom-binary-output-port"
1ee2c72e
LC
481 (let ((port (make-custom-binary-output-port "cbop"
482 (lambda (x y z) 0)
483 #f #f #f)))
484 (and (output-port? port)
485 (binary-port? port)
486 (not (port-has-port-position? port))
487 (not (port-has-set-port-position!? port)))))
488
489 (pass-if "make-custom-binary-output-port [partial writes]"
490 (let* ((source (uint-list->bytevector (iota 333)
491 (native-endianness) 2))
492 (sink (make-bytevector (bytevector-length source)))
493 (sink-pos 0)
494 (eof? #f)
495 (write! (lambda (bv start count)
496 (if (= 0 count)
497 (begin
498 (set! eof? #t)
499 0)
500 (let ((u8 (bytevector-u8-ref bv start)))
501 ;; Get one byte at a time.
502 (bytevector-u8-set! sink sink-pos u8)
503 (set! sink-pos (+ 1 sink-pos))
504 1))))
505 (port (make-custom-binary-output-port "cbop" write!
506 #f #f #f)))
507 (put-bytevector port source)
508 (and (= sink-pos (bytevector-length source))
509 (not eof?)
510 (bytevector=? sink source))))
511
512 (pass-if "make-custom-binary-output-port [full writes]"
513 (let* ((source (uint-list->bytevector (iota 333)
514 (native-endianness) 2))
515 (sink (make-bytevector (bytevector-length source)))
516 (sink-pos 0)
517 (eof? #f)
518 (write! (lambda (bv start count)
519 (if (= 0 count)
520 (begin
521 (set! eof? #t)
522 0)
523 (begin
524 (bytevector-copy! bv start
525 sink sink-pos
526 count)
527 (set! sink-pos (+ sink-pos count))
528 count))))
529 (port (make-custom-binary-output-port "cbop" write!
530 #f #f #f)))
531 (put-bytevector port source)
532 (and (= sink-pos (bytevector-length source))
533 (not eof?)
ead04a04
AR
534 (bytevector=? sink source))))
535
536 (pass-if "standard-output-port is binary"
537 (with-fluids ((%default-port-encoding "UTF-8"))
538 (binary-port? (standard-output-port))))
539
540 (pass-if "standard-error-port is binary"
541 (with-fluids ((%default-port-encoding "UTF-8"))
542 (binary-port? (standard-error-port)))))
1ee2c72e 543
d4b81637 544\f
1044537d 545(with-test-prefix "8.2.6 Input and output ports"
d4b81637 546
1044537d 547 (pass-if "transcoded-port [output]"
8aa47f26 548 (let ((s "Hello\nÄÖÜ"))
1044537d
AR
549 (bytevector=?
550 (string->utf8 s)
551 (call-with-bytevector-output-port
552 (lambda (bv-port)
553 (call-with-port (transcoded-port bv-port (make-transcoder (utf-8-codec)))
554 (lambda (utf8-port)
555 (put-string utf8-port s))))))))
d4b81637 556
1044537d 557 (pass-if "transcoded-port [input]"
8aa47f26 558 (let ((s "Hello\nÄÖÜ"))
1044537d
AR
559 (string=?
560 s
561 (get-string-all
562 (transcoded-port (open-bytevector-input-port (string->utf8 s))
563 (make-transcoder (utf-8-codec)))))))
d4b81637 564
1044537d 565 (pass-if "transcoded-port [input line]"
8aa47f26 566 (string=? "ÄÖÜ"
1044537d 567 (get-line (transcoded-port
8aa47f26 568 (open-bytevector-input-port (string->utf8 "ÄÖÜ\nFooBar"))
d4b81637
LC
569 (make-transcoder (utf-8-codec))))))
570
571 (pass-if "transcoded-port [error handling mode = raise]"
572 (let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
573 (error-handling-mode raise)))
574 (b (open-bytevector-input-port #vu8(255 2 1)))
575 (tp (transcoded-port b t)))
b1e76e8f
LC
576 (guard (c ((i/o-decoding-error? c)
577 (eq? (i/o-error-port c) tp)))
578 (get-line tp))))
d4b81637
LC
579
580 (pass-if "transcoded-port [error handling mode = replace]"
581 (let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
582 (error-handling-mode replace)))
583 (b (open-bytevector-input-port #vu8(255 1 2 3 103 110 117)))
584 (tp (transcoded-port b t)))
eed98cbc
LC
585 (string-suffix? "gnu" (get-line tp))))
586
587 (pass-if "transcoded-port, output [error handling mode = raise]"
588 (let-values (((p get)
589 (open-bytevector-output-port)))
590 (let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
591 (error-handling-mode raise)))
592 (tp (transcoded-port p t)))
593 (guard (c ((i/o-encoding-error? c)
594 (and (eq? (i/o-error-port c) tp)
595 (char=? (i/o-encoding-error-char c) #\λ)
596 (bytevector=? (get) (string->utf8 "The letter ")))))
597 (put-string tp "The letter λ cannot be represented in Latin-1.")
ead04a04
AR
598 #f))))
599
600 (pass-if "port-transcoder [binary port]"
601 (not (port-transcoder (open-bytevector-input-port #vu8()))))
602
603 (pass-if "port-transcoder [transcoded port]"
604 (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8 "foo"))
605 (make-transcoder (utf-8-codec))))
606 (t (port-transcoder p)))
607 (and t
608 (transcoder-codec t)
609 (eq? (native-eol-style)
610 (transcoder-eol-style t))
611 (eq? (error-handling-mode replace)
612 (transcoder-error-handling-mode t))))))
1044537d 613
a6c377f7
AR
614(with-test-prefix "8.2.9 Textual input"
615
616 (pass-if "get-string-n [short]"
617 (let ((port (open-input-string "GNU Guile")))
618 (string=? "GNU " (get-string-n port 4))))
619 (pass-if "get-string-n [long]"
620 (let ((port (open-input-string "GNU Guile")))
621 (string=? "GNU Guile" (get-string-n port 256))))
622 (pass-if "get-string-n [eof]"
623 (let ((port (open-input-string "")))
624 (eof-object? (get-string-n port 4))))
625
626 (pass-if "get-string-n! [short]"
627 (let ((port (open-input-string "GNU Guile"))
628 (s (string-copy "Isn't XXX great?")))
629 (and (= 3 (get-string-n! port s 6 3))
630 (string=? s "Isn't GNU great?")))))
631
1ee2c72e 632;;; Local Variables:
1ee2c72e 633;;; mode: scheme
b1e76e8f 634;;; eval: (put 'guard 'scheme-indent-function 1)
1ee2c72e 635;;; End: