summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-09-03 16:23:02 +0200
committerLudovic Courtès <ludo@gnu.org>2010-09-03 16:23:02 +0200
commitbf08e10f59c062a5d5173ed7951874ed86d302aa (patch)
tree773641c576f04ae5b1737e28c6656f79277cb8a4
parent760538bf75262811c906129a3ea2b6defde3d27d (diff)
downloadguile-bf08e10f59c062a5d5173ed7951874ed86d302aa.tar.gz
Fix the `put-bytevector' tests.
* libguile/vports.c (sf_write): Add comment about what happens when DATA contains binary data. * test-suite/tests/r6rs-ports.test ("7.2.11 Binary Output")["put-bytevector [2 args]", "put-bytevector [3 args]", "put-bytevector [4 args]"]: Require a Latin-1 locale.
-rw-r--r--libguile/vports.c6
-rw-r--r--test-suite/tests/r6rs-ports.test51
2 files changed, 35 insertions, 22 deletions
diff --git a/libguile/vports.c b/libguile/vports.c
index 4fab2df18..5178d79c7 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -78,6 +78,10 @@ sf_write (SCM port, const void *data, size_t size)
{
SCM p = SCM_PACK (SCM_STREAM (port));
+ /* DATA is assumed to be a locale-encoded C string, which makes it
+ hard to reliably pass binary data to a soft port. It can be
+ achieved by choosing a Latin-1 locale, though, but the recommended
+ approach is to use an R6RS "custom binary output port" instead. */
scm_call_1 (SCM_SIMPLE_VECTOR_REF (p, 1),
scm_from_locale_stringn ((char *) data, size));
}
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index dae6295e2..0b627da1a 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -185,32 +185,41 @@
(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