mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix the `put-bytevector' tests.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2010-09-03 16:23:02 +02:00
parent 760538bf75
commit bf08e10f59
2 changed files with 35 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/vports.c
View file

@ -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));
}

51
test-suite/tests/r6rs-ports.test
View file

@ -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