;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (rnrs io ports)
+ #:use-module (rnrs exceptions)
#:use-module (rnrs bytevectors))
;;; All these tests assume Guile 1.8's port system, where characters are
(pass-if "eof-object"
(and (eqv? (eof-object) (eof-object))
- (eq? (eof-object) (eof-object)))))
+ (eq? (eof-object) (eof-object))))
+
+ (pass-if "port-eof?"
+ (port-eof? (open-input-string ""))))
\f
(with-test-prefix "7.2.8 Binary Input"
(pass-if "put-bytevector with wrong-encoding string port"
(let* ((str "hello, world")
(bv (string->utf16 str)))
- (catch 'encoding-error
+ (catch 'decoding-error
(lambda ()
(with-fluids ((%default-port-encoding "UTF-32"))
(call-with-output-string
(lambda (port)
(put-bytevector port bv)))))
- (lambda (key subr message errno from to faulty-bv)
- (and (bytevector=? faulty-bv bv)
- (string=? to "UTF-32")
- (string? (strerror errno))))))))
+ (lambda (key subr message errno port)
+ (string? (strerror errno)))))))
\f
(with-test-prefix "7.2.7 Input Ports"
(u8-list->bytevector
(map char->integer (string->list "Port!")))))))
+ (pass-if "bytevector input port can seek to very end"
+ (let ((empty (open-bytevector-input-port '#vu8()))
+ (not-empty (open-bytevector-input-port '#vu8(1 2 3))))
+ (and (begin (set-port-position! empty (port-position empty))
+ (= 0 (port-position empty)))
+ (begin (get-bytevector-n not-empty 3)
+ (set-port-position! not-empty (port-position not-empty))
+ (= 3 (port-position not-empty))))))
+
(pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
exception:wrong-num-args
(close-port port)
(gc) ; Test for marking a closed port.
- closed?)))
+ closed?))
+
+ (pass-if "standard-input-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-input-port)))))
\f
(with-test-prefix "8.2.10 Output ports"
(put-bytevector port source)
(and (= sink-pos (bytevector-length source))
(not eof?)
- (bytevector=? sink source)))))
+ (bytevector=? sink source))))
+
+ (pass-if "standard-output-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-output-port))))
+
+ (pass-if "standard-error-port is binary"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (binary-port? (standard-error-port)))))
\f
(with-test-prefix "8.2.6 Input and output ports"
(error-handling-mode raise)))
(b (open-bytevector-input-port #vu8(255 2 1)))
(tp (transcoded-port b t)))
- ;; FIXME: Should be (guard (c ((i/o-decoding-error? c) #t)) ...).
- (catch 'encoding-error
- (lambda ()
- (get-line tp)
- #f)
- (lambda _
- #t))))
+ (guard (c ((i/o-decoding-error? c)
+ (eq? (i/o-error-port c) tp)))
+ (get-line tp))))
(pass-if "transcoded-port [error handling mode = replace]"
(let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
(error-handling-mode replace)))
(b (open-bytevector-input-port #vu8(255 1 2 3 103 110 117)))
(tp (transcoded-port b t)))
- (string-suffix? "gnu" (get-line tp)))))
+ (string-suffix? "gnu" (get-line tp))))
+
+ (pass-if "transcoded-port, output [error handling mode = raise]"
+ (let-values (((p get)
+ (open-bytevector-output-port)))
+ (let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
+ (error-handling-mode raise)))
+ (tp (transcoded-port p t)))
+ (guard (c ((i/o-encoding-error? c)
+ (and (eq? (i/o-error-port c) tp)
+ (char=? (i/o-encoding-error-char c) #\λ)
+ (bytevector=? (get) (string->utf8 "The letter ")))))
+ (put-string tp "The letter λ cannot be represented in Latin-1.")
+ #f))))
+
+ (pass-if "port-transcoder [binary port]"
+ (not (port-transcoder (open-bytevector-input-port #vu8()))))
+
+ (pass-if "port-transcoder [transcoded port]"
+ (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8 "foo"))
+ (make-transcoder (utf-8-codec))))
+ (t (port-transcoder p)))
+ (and t
+ (transcoder-codec t)
+ (eq? (native-eol-style)
+ (transcoder-eol-style t))
+ (eq? (error-handling-mode replace)
+ (transcoder-error-handling-mode t))))))
+
+(with-test-prefix "8.2.9 Textual input"
+
+ (pass-if "get-string-n [short]"
+ (let ((port (open-input-string "GNU Guile")))
+ (string=? "GNU " (get-string-n port 4))))
+ (pass-if "get-string-n [long]"
+ (let ((port (open-input-string "GNU Guile")))
+ (string=? "GNU Guile" (get-string-n port 256))))
+ (pass-if "get-string-n [eof]"
+ (let ((port (open-input-string "")))
+ (eof-object? (get-string-n port 4))))
+
+ (pass-if "get-string-n! [short]"
+ (let ((port (open-input-string "GNU Guile"))
+ (s (string-copy "Isn't XXX great?")))
+ (and (= 3 (get-string-n! port s 6 3))
+ (string=? s "Isn't GNU great?")))))
;;; Local Variables:
;;; mode: scheme
+;;; eval: (put 'guard 'scheme-indent-function 1)
;;; End:
HCoop / bpt / guile.git / blobdiff