1 ;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
3 ;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
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
9 ;;;; version 3 of the License, or (at your option) any later version.
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.
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
20 (define-module (test-io-ports)
21 #:use-module (test-suite lib)
22 #:use-module (test-suite guile-test)
23 #:use-module (srfi srfi-1)
24 #:use-module (srfi srfi-11)
25 #:use-module (rnrs io ports)
26 #:use-module (rnrs io simple)
27 #:use-module (rnrs exceptions)
28 #:use-module (rnrs bytevectors))
30 (define-syntax pass-if-condition
32 ((_ name predicate body0 body ...)
33 (let ((cookie (list 'cookie)))
35 (eq? cookie (guard (c ((predicate c) cookie))
39 (data-file-name "ports-test.tmp"))
41 ;; A input/output port that swallows all output, and produces just
42 ;; spaces on input. Reading and writing beyond `failure-position'
43 ;; produces `system-error' exceptions. Used for testing exception
45 (define* (make-failing-port #:optional (failure-position 0))
46 (define (maybe-fail index errno)
47 (if (> index failure-position)
48 (scm-error 'system-error
50 "I/O beyond failure position" '()
54 (define (write-char chr)
55 (set! write-index (+ 1 write-index))
56 (maybe-fail write-index ENOSPC))
59 (lambda (str) ;; write-string
60 (for-each write-char (string->list str)))
61 (lambda () #t) ;; flush-output
62 (lambda () ;; read-char
63 (set! read-index (+ read-index 1))
64 (maybe-fail read-index EIO)
66 (lambda () #t)) ;; close-port
69 (define (call-with-bytevector-output-port/transcoded transcoder receiver)
70 (call-with-bytevector-output-port
72 (call-with-port (transcoded-port bv-port transcoder)
76 (with-test-prefix "7.2.5 End-of-File Object"
79 (and (eqv? (eof-object) (eof-object))
80 (eq? (eof-object) (eof-object))))
83 (port-eof? (open-input-string ""))))
86 (with-test-prefix "7.2.8 Binary Input"
89 (let ((port (open-input-string "A")))
90 (and (= (char->integer #\A) (get-u8 port))
91 (eof-object? (get-u8 port)))))
93 (pass-if "lookahead-u8"
94 (let ((port (open-input-string "A")))
95 (and (= (char->integer #\A) (lookahead-u8 port))
96 (= (char->integer #\A) (lookahead-u8 port))
97 (= (char->integer #\A) (get-u8 port))
98 (eof-object? (get-u8 port)))))
100 (pass-if "lookahead-u8 non-ASCII"
101 (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
102 (open-input-string "λ"))))
103 (and (= 206 (lookahead-u8 port))
104 (= 206 (lookahead-u8 port))
105 (= 206 (get-u8 port))
106 (= 187 (lookahead-u8 port))
107 (= 187 (lookahead-u8 port))
108 (= 187 (get-u8 port))
109 (eof-object? (lookahead-u8 port))
110 (eof-object? (get-u8 port)))))
112 (pass-if "lookahead-u8: result is unsigned"
114 (let ((port (open-bytevector-input-port #vu8(255))))
115 (= (lookahead-u8 port) 255)))
117 (pass-if "get-bytevector-n [short]"
118 (let* ((port (open-input-string "GNU Guile"))
119 (bv (get-bytevector-n port 4)))
120 (and (bytevector? bv)
121 (equal? (bytevector->u8-list bv)
122 (map char->integer (string->list "GNU "))))))
124 (pass-if "get-bytevector-n [long]"
125 (let* ((port (open-input-string "GNU Guile"))
126 (bv (get-bytevector-n port 256)))
127 (and (bytevector? bv)
128 (equal? (bytevector->u8-list bv)
129 (map char->integer (string->list "GNU Guile"))))))
131 (pass-if-exception "get-bytevector-n with closed port"
132 exception:wrong-type-arg
134 (let ((port (%make-void-port "r")))
137 (get-bytevector-n port 3)))
139 (pass-if "get-bytevector-n! [short]"
140 (let* ((port (open-input-string "GNU Guile"))
141 (bv (make-bytevector 4))
142 (read (get-bytevector-n! port bv 0 4)))
144 (equal? (bytevector->u8-list bv)
145 (map char->integer (string->list "GNU "))))))
147 (pass-if "get-bytevector-n! [long]"
148 (let* ((str "GNU Guile")
149 (port (open-input-string str))
150 (bv (make-bytevector 256))
151 (read (get-bytevector-n! port bv 0 256)))
152 (and (equal? read (string-length str))
153 (equal? (map (lambda (i)
154 (bytevector-u8-ref bv i))
156 (map char->integer (string->list str))))))
158 (pass-if "get-bytevector-some [simple]"
159 (let* ((str "GNU Guile")
160 (port (open-input-string str))
161 (bv (get-bytevector-some port)))
162 (and (bytevector? bv)
163 (equal? (bytevector->u8-list bv)
164 (map char->integer (string->list str))))))
166 (pass-if "get-bytevector-some [only-some]"
167 (let* ((str "GNU Guile")
169 (port (make-soft-port
172 (if (>= index (string-length str))
174 (let ((c (string-ref str index)))
175 (set! index (+ index 1))
179 ;; Number of readily available octets: falls to
180 ;; zero after 4 octets have been read.
181 (- 4 (modulo index 5))))
183 (bv (get-bytevector-some port)))
184 (and (bytevector? bv)
186 (= (bytevector-length bv) index)
187 (equal? (bytevector->u8-list bv)
188 (map char->integer (string->list "GNU "))))))
190 (pass-if "get-bytevector-all"
191 (let* ((str "GNU Guile")
193 (port (make-soft-port
196 (if (>= index (string-length str))
198 (let ((c (string-ref str index)))
199 (set! index (+ index 1))
204 ;; Number of readily available octets: falls to
205 ;; zero after 4 octets have been read and then
208 (- (string-length str) index)
209 (- 4 (modulo index 5)))))
210 (if (= 0 a) (set! cont? #t))
213 (bv (get-bytevector-all port)))
214 (and (bytevector? bv)
215 (= index (string-length str))
216 (= (bytevector-length bv) (string-length str))
217 (equal? (bytevector->u8-list bv)
218 (map char->integer (string->list str)))))))
221 (define (make-soft-output-port)
222 (let* ((bv (make-bytevector 1024))
225 (write-char (lambda (chr)
226 (bytevector-u8-set! bv write-index
228 (set! write-index (+ 1 write-index)))))
231 (lambda (str) ;; write-string
232 (for-each write-char (string->list str)))
233 (lambda () #t) ;; flush-output
234 (lambda () ;; read-char
235 (if (>= read-index (bytevector-length bv))
237 (let ((c (bytevector-u8-ref bv read-index)))
238 (set! read-index (+ read-index 1))
240 (lambda () #t)) ;; close-port
243 (with-test-prefix "7.2.11 Binary Output"
246 (let ((port (make-soft-output-port)))
248 (equal? (get-u8 port) 77)))
250 ;; Note: The `put-bytevector' tests below require a Latin-1 locale so
251 ;; that the `scm_from_locale_stringn' call in `sf_write' will let all
252 ;; the bytes through, unmodified. This is hacky, but we can't use
253 ;; "custom binary output ports" here because they're only tested
256 (pass-if "put-bytevector [2 args]"
258 (let ((port (make-soft-output-port))
259 (bv (make-bytevector 256)))
260 (put-bytevector port bv)
261 (equal? (bytevector->u8-list bv)
263 (get-bytevector-n port (bytevector-length bv)))))))
265 (pass-if "put-bytevector [3 args]"
267 (let ((port (make-soft-output-port))
268 (bv (make-bytevector 256))
270 (put-bytevector port bv start)
271 (equal? (drop (bytevector->u8-list bv) start)
273 (get-bytevector-n port (- (bytevector-length bv) start)))))))
275 (pass-if "put-bytevector [4 args]"
277 (let ((port (make-soft-output-port))
278 (bv (make-bytevector 256))
281 (put-bytevector port bv start count)
282 (equal? (take (drop (bytevector->u8-list bv) start) count)
284 (get-bytevector-n port count))))))
286 (pass-if-exception "put-bytevector with closed port"
287 exception:wrong-type-arg
289 (let* ((bv (make-bytevector 4))
290 (port (%make-void-port "w")))
293 (put-bytevector port bv)))
295 (pass-if "put-bytevector with UTF-16 string port"
296 (let* ((str "hello, world")
297 (bv (string->utf16 str)))
299 (with-fluids ((%default-port-encoding "UTF-16BE"))
300 (call-with-output-string
302 (put-bytevector port bv)))))))
304 (pass-if "put-bytevector with wrong-encoding string port"
305 (let* ((str "hello, world")
306 (bv (string->utf16 str)))
307 (catch 'decoding-error
309 (with-fluids ((%default-port-encoding "UTF-32")
310 (%default-port-conversion-strategy 'error))
311 (call-with-output-string
313 (put-bytevector port bv)))
314 #f)) ; fail if we reach this point
315 (lambda (key subr message errno port)
316 (string? (strerror errno)))))))
319 (with-test-prefix "7.2.7 Input Ports"
321 (let ((filename (test-file))
322 (contents (string->utf8 "GNU λ")))
325 (call-with-output-file filename
326 (lambda (port) (put-bytevector port contents)))
328 (pass-if "open-file-input-port [opens binary port]"
329 (with-fluids ((%default-port-encoding "UTF-8"))
330 (call-with-port (open-file-input-port filename)
332 (and (binary-port? port)
333 (bytevector=? contents (get-bytevector-all port)))))))
335 (delete-file filename))
337 ;; This section appears here so that it can use the binary input
340 (pass-if "open-bytevector-input-port [1 arg]"
341 (let* ((str "Hello Port!")
342 (bv (u8-list->bytevector (map char->integer
343 (string->list str))))
344 (port (open-bytevector-input-port bv))
347 (let loop ((chr (read-char port))
349 (if (eof-object? chr)
350 (apply string (reverse! result))
351 (loop (read-char port)
352 (cons chr result)))))))
354 (equal? (read-to-string port) str)))
356 (pass-if "bytevector-input-port is binary"
357 (with-fluids ((%default-port-encoding "UTF-8"))
358 (binary-port? (open-bytevector-input-port #vu8(1 2 3)))))
360 (pass-if-exception "bytevector-input-port is read-only"
361 exception:wrong-type-arg
363 (let* ((str "Hello Port!")
364 (bv (u8-list->bytevector (map char->integer
365 (string->list str))))
366 (port (open-bytevector-input-port bv #f)))
368 (write "hello" port)))
370 (pass-if "bytevector input port supports seeking"
371 (let* ((str "Hello Port!")
372 (bv (u8-list->bytevector (map char->integer
373 (string->list str))))
374 (port (open-bytevector-input-port bv #f)))
376 (and (port-has-port-position? port)
377 (= 0 (port-position port))
378 (port-has-set-port-position!? port)
380 (set-port-position! port 6)
381 (= 6 (port-position port)))
382 (bytevector=? (get-bytevector-all port)
384 (map char->integer (string->list "Port!")))))))
386 (pass-if "bytevector input port can seek to very end"
387 (let ((empty (open-bytevector-input-port '#vu8()))
388 (not-empty (open-bytevector-input-port '#vu8(1 2 3))))
389 (and (begin (set-port-position! empty (port-position empty))
390 (= 0 (port-position empty)))
391 (begin (get-bytevector-n not-empty 3)
392 (set-port-position! not-empty (port-position not-empty))
393 (= 3 (port-position not-empty))))))
395 (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
396 exception:wrong-num-args
398 ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
400 (make-custom-binary-input-port "port" (lambda args #t)))
402 (pass-if "make-custom-binary-input-port"
403 (let* ((source (make-bytevector 7777))
405 (len (bytevector-length source)))
406 (lambda (bv start count)
407 (let ((amount (min count (- len pos))))
409 (bytevector-copy! source pos
411 (set! pos (+ pos amount))
413 (port (make-custom-binary-input-port "the port" read!
416 (and (binary-port? port)
418 (bytevector=? (get-bytevector-all port) source))))
420 (pass-if "custom binary input port does not support `port-position'"
421 (let* ((str "Hello Port!")
422 (source (open-bytevector-input-port
424 (map char->integer (string->list str)))))
425 (read! (lambda (bv start count)
426 (let ((r (get-bytevector-n! source bv start count)))
430 (port (make-custom-binary-input-port "the port" read!
432 (not (or (port-has-port-position? port)
433 (port-has-set-port-position!? port)))))
435 (pass-if "custom binary input port supports `port-position'"
436 (let* ((str "Hello Port!")
437 (source (open-bytevector-input-port
439 (map char->integer (string->list str)))))
440 (read! (lambda (bv start count)
441 (let ((r (get-bytevector-n! source bv start count)))
446 (port-position source)))
447 (set-pos! (lambda (pos)
448 (set-port-position! source pos)))
449 (port (make-custom-binary-input-port "the port" read!
450 get-pos set-pos! #f)))
452 (and (port-has-port-position? port)
453 (= 0 (port-position port))
454 (port-has-set-port-position!? port)
456 (set-port-position! port 6)
457 (= 6 (port-position port)))
458 (bytevector=? (get-bytevector-all port)
460 (map char->integer (string->list "Port!")))))))
462 (pass-if "custom binary input port `close-proc' is called"
464 (read! (lambda (bv start count) 0))
465 (get-pos (lambda () 0))
466 (set-pos! (lambda (pos) #f))
467 (close! (lambda () (set! closed? #t)))
468 (port (make-custom-binary-input-port "the port" read!
473 (gc) ; Test for marking a closed port.
476 (pass-if "standard-input-port is binary"
477 (with-fluids ((%default-port-encoding "UTF-8"))
478 (binary-port? (standard-input-port)))))
481 (with-test-prefix "8.2.10 Output ports"
483 (let ((filename (test-file)))
484 (with-fluids ((%default-port-encoding "UTF-8"))
485 (pass-if "open-file-output-port [opens binary port]"
486 (call-with-port (open-file-output-port filename)
488 (put-bytevector port '#vu8(1 2 3))
489 (binary-port? port)))))
491 (pass-if-condition "open-file-output-port [exception: already-exists]"
492 i/o-file-already-exists-error?
493 (open-file-output-port filename))
495 (pass-if "open-file-output-port [no-fail no-truncate]"
497 (call-with-port (open-file-output-port filename
498 (file-options no-fail no-truncate))
500 (= 0 (port-position port))))
501 (= 3 (stat:size (stat filename)))))
503 (pass-if "open-file-output-port [no-fail]"
505 (call-with-port (open-file-output-port filename (file-options no-fail))
507 (= 0 (stat:size (stat filename)))))
509 (delete-file filename)
511 (pass-if-condition "open-file-output-port [exception: does-not-exist]"
512 i/o-file-does-not-exist-error?
513 (open-file-output-port filename (file-options no-create))))
515 (pass-if "open-bytevector-output-port"
516 (let-values (((port get-content)
517 (open-bytevector-output-port #f)))
518 (let ((source (make-bytevector 7777)))
519 (put-bytevector port source)
520 (and (bytevector=? (get-content) source)
521 (bytevector=? (get-content) (make-bytevector 0))))))
523 (pass-if "bytevector-output-port is binary"
524 (binary-port? (open-bytevector-output-port)))
526 (pass-if "open-bytevector-output-port [extract after close]"
527 (let-values (((port get-content)
528 (open-bytevector-output-port)))
529 (let ((source (make-bytevector 12345 #xFE)))
530 (put-bytevector port source)
532 (bytevector=? (get-content) source))))
534 (pass-if "open-bytevector-output-port [put-u8]"
535 (let-values (((port get-content)
536 (open-bytevector-output-port)))
538 (and (bytevector=? (get-content) (make-bytevector 1 77))
539 (bytevector=? (get-content) (make-bytevector 0)))))
541 (pass-if "open-bytevector-output-port [display]"
542 (let-values (((port get-content)
543 (open-bytevector-output-port)))
544 (display "hello" port)
545 (and (bytevector=? (get-content) (string->utf8 "hello"))
546 (bytevector=? (get-content) (make-bytevector 0)))))
548 (pass-if "bytevector output port supports `port-position'"
549 (let-values (((port get-content)
550 (open-bytevector-output-port)))
551 (let ((source (make-bytevector 7777))
552 (overwrite (make-bytevector 33)))
553 (and (port-has-port-position? port)
554 (port-has-set-port-position!? port)
556 (put-bytevector port source)
557 (= (bytevector-length source)
558 (port-position port)))
560 (set-port-position! port 10)
561 (= 10 (port-position port)))
563 (put-bytevector port overwrite)
564 (bytevector-copy! overwrite 0 source 10
565 (bytevector-length overwrite))
566 (= (port-position port)
567 (+ 10 (bytevector-length overwrite))))
568 (bytevector=? (get-content) source)
569 (bytevector=? (get-content) (make-bytevector 0))))))
571 (pass-if "make-custom-binary-output-port"
572 (let ((port (make-custom-binary-output-port "cbop"
575 (and (output-port? port)
577 (not (port-has-port-position? port))
578 (not (port-has-set-port-position!? port)))))
580 (pass-if "make-custom-binary-output-port [partial writes]"
581 (let* ((source (uint-list->bytevector (iota 333)
582 (native-endianness) 2))
583 (sink (make-bytevector (bytevector-length source)))
586 (write! (lambda (bv start count)
591 (let ((u8 (bytevector-u8-ref bv start)))
592 ;; Get one byte at a time.
593 (bytevector-u8-set! sink sink-pos u8)
594 (set! sink-pos (+ 1 sink-pos))
596 (port (make-custom-binary-output-port "cbop" write!
598 (put-bytevector port source)
599 (and (= sink-pos (bytevector-length source))
601 (bytevector=? sink source))))
603 (pass-if "make-custom-binary-output-port [full writes]"
604 (let* ((source (uint-list->bytevector (iota 333)
605 (native-endianness) 2))
606 (sink (make-bytevector (bytevector-length source)))
609 (write! (lambda (bv start count)
615 (bytevector-copy! bv start
618 (set! sink-pos (+ sink-pos count))
620 (port (make-custom-binary-output-port "cbop" write!
622 (put-bytevector port source)
623 (and (= sink-pos (bytevector-length source))
625 (bytevector=? sink source))))
627 (pass-if "standard-output-port is binary"
628 (with-fluids ((%default-port-encoding "UTF-8"))
629 (binary-port? (standard-output-port))))
631 (pass-if "standard-error-port is binary"
632 (with-fluids ((%default-port-encoding "UTF-8"))
633 (binary-port? (standard-error-port)))))
636 (with-test-prefix "8.2.6 Input and output ports"
638 (pass-if "transcoded-port [output]"
639 (let ((s "Hello\nÄÖÜ"))
642 (call-with-bytevector-output-port/transcoded (make-transcoder (utf-8-codec))
644 (put-string utf8-port s))))))
646 (pass-if "transcoded-port [input]"
647 (let ((s "Hello\nÄÖÜ"))
651 (transcoded-port (open-bytevector-input-port (string->utf8 s))
652 (make-transcoder (utf-8-codec)))))))
654 (pass-if "transcoded-port [input line]"
656 (get-line (transcoded-port
657 (open-bytevector-input-port (string->utf8 "ÄÖÜ\nFooBar"))
658 (make-transcoder (utf-8-codec))))))
660 (pass-if "transcoded-port [error handling mode = raise]"
661 (let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
662 (error-handling-mode raise)))
663 (b (open-bytevector-input-port #vu8(255 2 1)))
664 (tp (transcoded-port b t)))
665 (guard (c ((i/o-decoding-error? c)
666 (eq? (i/o-error-port c) tp)))
668 #f))) ; fail if we reach this point
670 (pass-if "transcoded-port [error handling mode = replace]"
671 (let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
672 (error-handling-mode replace)))
673 (b (open-bytevector-input-port #vu8(255 1 2 3 103 110 117)))
674 (tp (transcoded-port b t)))
675 (string-suffix? "gnu" (get-line tp))))
677 (pass-if "transcoded-port, output [error handling mode = raise]"
678 (let-values (((p get)
679 (open-bytevector-output-port)))
680 (let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
681 (error-handling-mode raise)))
682 (tp (transcoded-port p t)))
683 (guard (c ((i/o-encoding-error? c)
684 (and (eq? (i/o-error-port c) tp)
685 (char=? (i/o-encoding-error-char c) #\λ)
686 (bytevector=? (get) (string->utf8 "The letter ")))))
687 (put-string tp "The letter λ cannot be represented in Latin-1.")
690 (pass-if "port-transcoder [binary port]"
691 (not (port-transcoder (open-bytevector-input-port #vu8()))))
693 (pass-if "port-transcoder [transcoded port]"
694 (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8 "foo"))
695 (make-transcoder (utf-8-codec))))
696 (t (port-transcoder p)))
699 (eq? (native-eol-style)
700 (transcoder-eol-style t))
701 (eq? (error-handling-mode replace)
702 (transcoder-error-handling-mode t))))))
704 (with-test-prefix "8.2.9 Textual input"
706 (pass-if "get-string-n [short]"
707 (let ((port (open-input-string "GNU Guile")))
708 (string=? "GNU " (get-string-n port 4))))
709 (pass-if "get-string-n [long]"
710 (let ((port (open-input-string "GNU Guile")))
711 (string=? "GNU Guile" (get-string-n port 256))))
712 (pass-if "get-string-n [eof]"
713 (let ((port (open-input-string "")))
714 (eof-object? (get-string-n port 4))))
716 (pass-if "get-string-n! [short]"
717 (let ((port (open-input-string "GNU Guile"))
718 (s (string-copy "Isn't XXX great?")))
719 (and (= 3 (get-string-n! port s 6 3))
720 (string=? s "Isn't GNU great?"))))
722 (with-test-prefix "read error"
723 (pass-if-condition "get-char" i/o-read-error?
724 (get-char (make-failing-port)))
725 (pass-if-condition "lookahead-char" i/o-read-error?
726 (lookahead-char (make-failing-port)))
727 ;; FIXME: these are not yet exception-correct
729 (pass-if-condition "get-string-n" i/o-read-error?
730 (get-string-n (make-failing-port) 5))
731 (pass-if-condition "get-string-n!" i/o-read-error?
732 (get-string-n! (make-failing-port) (make-string 5) 0 5))
734 (pass-if-condition "get-string-all" i/o-read-error?
735 (get-string-all (make-failing-port 100)))
736 (pass-if-condition "get-line" i/o-read-error?
737 (get-line (make-failing-port)))
738 (pass-if-condition "get-datum" i/o-read-error?
739 (get-datum (make-failing-port)))))
741 (define (encoding-error-predicate char)
743 (and (i/o-encoding-error? c)
744 (char=? char (i/o-encoding-error-char c)))))
746 (with-test-prefix "8.2.12 Textual Output"
748 (with-test-prefix "write error"
749 (pass-if-condition "put-char" i/o-write-error?
750 (put-char (make-failing-port) #\G))
751 (pass-if-condition "put-string" i/o-write-error?
752 (put-string (make-failing-port) "Hello World!"))
753 (pass-if-condition "put-datum" i/o-write-error?
754 (put-datum (make-failing-port) '(hello world!))))
755 (with-test-prefix "encoding error"
756 (pass-if-condition "put-char" (encoding-error-predicate #\λ)
757 (call-with-bytevector-output-port/transcoded
758 (make-transcoder (latin-1-codec)
760 (error-handling-mode raise))
762 (put-char port #\λ))))
763 (pass-if-condition "put-string" (encoding-error-predicate #\λ)
764 (call-with-bytevector-output-port/transcoded
765 (make-transcoder (latin-1-codec)
767 (error-handling-mode raise))
769 (put-string port "FooλBar"))))))
771 (with-test-prefix "8.3 Simple I/O"
772 (with-test-prefix "read error"
773 (pass-if-condition "read-char" i/o-read-error?
774 (read-char (make-failing-port)))
775 (pass-if-condition "peek-char" i/o-read-error?
776 (peek-char (make-failing-port)))
777 (pass-if-condition "read" i/o-read-error?
778 (read (make-failing-port))))
779 (with-test-prefix "write error"
780 (pass-if-condition "display" i/o-write-error?
781 (display "Hi there!" (make-failing-port)))
782 (pass-if-condition "write" i/o-write-error?
783 (write '(hi there!) (make-failing-port)))
784 (pass-if-condition "write-char" i/o-write-error?
785 (write-char #\G (make-failing-port)))
786 (pass-if-condition "newline" i/o-write-error?
787 (newline (make-failing-port))))
788 (let ((filename (test-file)))
789 ;; ensure the test file exists
790 (call-with-output-file filename
791 (lambda (port) (write "foo" port)))
792 (pass-if "call-with-input-file [port is textual]"
793 (call-with-input-file filename textual-port?))
794 (pass-if-condition "call-with-input-file [exception: not-found]"
795 i/o-file-does-not-exist-error?
796 (call-with-input-file ",this-is-highly-unlikely-to-exist!"
798 (pass-if-condition "call-with-output-file [exception: already-exists]"
799 i/o-file-already-exists-error?
800 (call-with-output-file filename
802 (delete-file filename)))
806 ;;; eval: (put 'guard 'scheme-indent-function 1)