summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-08-16 23:10:14 -0400
committerMark H Weaver <mhw@netris.org>2013-08-16 23:13:54 -0400
commitc099201da1de71652b9791fb0a3a863b6d3c355d (patch)
tree528a272b65dc627445da3a3100acc551923ebcfe
parent88cff2ef1bd0d11987f034d2e7dec10c89f5719d (diff)
downloadguile-c099201da1de71652b9791fb0a3a863b6d3c355d.tar.gz
In bytevector->uint-list et al, check that SIZE divides the bv length.
Fixes <http://bugs.gnu.org/15100>. Reported by Göran Weinholt <goran@weinholt.se>. * libguile/bytevectors.c (INTEGERS_TO_LIST): Enforce the R6RS requirement that SIZE divides the bytevector length. * test-suite/tests/bytevectors.test: Add test. Remove tests that assumes that this "divides" check is not enforced.
-rw-r--r--libguile/bytevectors.c6
-rw-r--r--test-suite/tests/bytevectors.test11
2 files changed, 8 insertions, 9 deletions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 56c00cb6e..f91b8451c 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1119,7 +1119,11 @@ SCM_DEFINE (scm_bytevector_sint_set_x, "bytevector-sint-set!", 5, 0, 0,
c_size = scm_to_unsigned_integer (size, 1, (size_t) -1); \
\
c_len = SCM_BYTEVECTOR_LENGTH (bv); \
- if (SCM_UNLIKELY (c_len < c_size)) \
+ if (SCM_UNLIKELY (c_len % c_size != 0)) \
+ scm_wrong_type_arg_msg \
+ (FUNC_NAME, 0, size, \
+ "an exact positive integer that divides the bytevector length"); \
+ else if (SCM_UNLIKELY (c_len == 0)) \
lst = SCM_EOL; \
else \
{ \
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
index 524ce86b5..28ccbf585 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -155,10 +155,6 @@
(let ((b (make-bytevector 0)))
(null? (bytevector->uint-list b (endianness big) 2))))
- (pass-if "bytevector->sint-list [length < word size]"
- (let ((b (make-bytevector 1)))
- (null? (bytevector->sint-list b (endianness big) 2))))
-
(pass-if-exception "bytevector->sint-list [out-of-range]"
exception:out-of-range
(bytevector->sint-list (make-bytevector 6) (endianness little) -1))
@@ -167,10 +163,9 @@
exception:out-of-range
(bytevector->uint-list (make-bytevector 6) (endianness little) 0))
- (pass-if "bytevector->sint-list [off-by-one]"
- (equal? (bytevector->sint-list (make-bytevector 31 #xff)
- (endianness little) 8)
- '(-1 -1 -1)))
+ (pass-if-exception "bytevector->uint-list [word size doesn't divide length]"
+ exception:wrong-type-arg
+ (bytevector->uint-list (make-bytevector 6) (endianness little) 4))
(pass-if "{sint,uint}-list->bytevector"
(let ((b1 (sint-list->bytevector '(513 -253 513 513)