diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-09-03 16:23:02 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-09-03 16:23:02 +0200 |
commit | bf08e10f59c062a5d5173ed7951874ed86d302aa (patch) | |
tree | 773641c576f04ae5b1737e28c6656f79277cb8a4 | |
parent | 760538bf75262811c906129a3ea2b6defde3d27d (diff) | |
download | guile-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.c | 6 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 51 |
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 |