-;;;; r6rs-ports.test --- Exercise the R6RS I/O port API.
+;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: iso-8859-1; -*-
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 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 bytevector))
+ :use-module (rnrs bytevectors))
;;; All these tests assume Guile 1.8's port system, where characters are
;;; treated as octets.
-;;; Set the default encoding of future ports to be binary
-(setbinary)
+;; Set the default encoding of future ports to be Latin-1.
+(fluid-set! %default-port-encoding #f)
\f
(with-test-prefix "7.2.5 End-of-File Object"
(= (char->integer #\A) (get-u8 port))
(eof-object? (get-u8 port)))))
+ (pass-if "lookahead-u8: result is unsigned"
+ ;; Bug #31081.
+ (let ((port (open-bytevector-input-port #vu8(255))))
+ (= (lookahead-u8 port) 255)))
+
(pass-if "get-bytevector-n [short]"
(let* ((port (open-input-string "GNU Guile"))
(bv (get-bytevector-n port 4)))
(put-u8 port 77)
(equal? (get-u8 port) 77)))
+ ;; Note: The `put-bytevector' tests below require a Latin-1 locale so
+ ;; that the `scm_from_locale_stringn' call in `sf_write' will let all
+ ;; the bytes through, unmodified. This is hacky, but we can't use
+ ;; "custom binary output ports" here because they're only tested
+ ;; later.
+
(pass-if "put-bytevector [2 args]"
- (let ((port (make-soft-output-port))
- (bv (make-bytevector 256)))
- (put-bytevector port bv)
- (equal? (bytevector->u8-list bv)
- (bytevector->u8-list
- (get-bytevector-n port (bytevector-length bv))))))
+ (with-latin1-locale
+ (let ((port (make-soft-output-port))
+ (bv (make-bytevector 256)))
+ (put-bytevector port bv)
+ (equal? (bytevector->u8-list bv)
+ (bytevector->u8-list
+ (get-bytevector-n port (bytevector-length bv)))))))
(pass-if "put-bytevector [3 args]"
- (let ((port (make-soft-output-port))
- (bv (make-bytevector 256))
- (start 10))
- (put-bytevector port bv start)
- (equal? (drop (bytevector->u8-list bv) start)
- (bytevector->u8-list
- (get-bytevector-n port (- (bytevector-length bv) start))))))
+ (with-latin1-locale
+ (let ((port (make-soft-output-port))
+ (bv (make-bytevector 256))
+ (start 10))
+ (put-bytevector port bv start)
+ (equal? (drop (bytevector->u8-list bv) start)
+ (bytevector->u8-list
+ (get-bytevector-n port (- (bytevector-length bv) start)))))))
(pass-if "put-bytevector [4 args]"
- (let ((port (make-soft-output-port))
- (bv (make-bytevector 256))
- (start 10)
- (count 77))
- (put-bytevector port bv start count)
- (equal? (take (drop (bytevector->u8-list bv) start) count)
- (bytevector->u8-list
- (get-bytevector-n port count)))))
+ (with-latin1-locale
+ (let ((port (make-soft-output-port))
+ (bv (make-bytevector 256))
+ (start 10)
+ (count 77))
+ (put-bytevector port bv start count)
+ (equal? (take (drop (bytevector->u8-list bv) start) count)
+ (bytevector->u8-list
+ (get-bytevector-n port count))))))
(pass-if-exception "put-bytevector with closed port"
exception:wrong-type-arg
(port (%make-void-port "w")))
(close-port port)
- (put-bytevector port bv))))
+ (put-bytevector port bv)))
+
+ (pass-if "put-bytevector with UTF-16 string port"
+ (let* ((str "hello, world")
+ (bv (string->utf16 str)))
+ (equal? str
+ (with-fluids ((%default-port-encoding "UTF-16BE"))
+ (call-with-output-string
+ (lambda (port)
+ (put-bytevector port bv)))))))
+
+ (pass-if "put-bytevector with wrong-encoding string port"
+ (let* ((str "hello, world")
+ (bv (string->utf16 str)))
+ (catch 'encoding-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))))))))
\f
(with-test-prefix "7.2.7 Input Ports"
(not eof?)
(bytevector=? sink source)))))
-
;;; Local Variables:
-;;; coding: latin-1
;;; mode: scheme
;;; End: