summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2012-03-01 16:07:28 -0500
committerMark H Weaver <mhw@netris.org>2012-03-01 16:16:18 -0500
commitef405f8ba73fc57706d7155a2e008352416debcf (patch)
tree81dbc0739ac01c0a05e0fc6912c916743ae29bb4
parentd316047326fde9d63ca52c0051fbf09124ef297e (diff)
downloadguile-ef405f8ba73fc57706d7155a2e008352416debcf.tar.gz
Fix <TAG>vector-length when applied to other uniform vector types
* module/srfi/srfi-4.scm, module/srfi/srfi-4/gnu.scm (define-bytevector-type): Fix definition of <TAG>vector-length when applied to uniform vectors of different element sizes. Thanks to Tobias Brandt <tob.brandt@googlemail.com> for reporting this bug. * test-suite/tests/srfi-4.test: Add tests.
-rw-r--r--module/srfi/srfi-4.scm6
-rw-r--r--module/srfi/srfi-4/gnu.scm5
-rw-r--r--test-suite/tests/srfi-4.test25
3 files changed, 32 insertions, 4 deletions
diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index 818ae7a73..43f5ef68f 100644
--- a/module/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -1,6 +1,7 @@
;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes
-;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010,
+;; 2012 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
@@ -79,7 +80,8 @@
(apply make-srfi-4-vector ',tag len fill))
(define (,(symbol-append tag 'vector-length) v)
(let ((len (* (uniform-vector-length v)
- (/ ,size (uniform-vector-element-size v)))))
+ (uniform-vector-element-size v)
+ (/ ,size))))
(if (integer? len)
len
(error "fractional length" v ',tag ,size))))
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
index ac22809ea..39d6350e7 100644
--- a/module/srfi/srfi-4/gnu.scm
+++ b/module/srfi/srfi-4/gnu.scm
@@ -1,6 +1,6 @@
;;; Extensions to SRFI-4
-;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012 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
@@ -52,7 +52,8 @@
(apply make-srfi-4-vector ',tag len fill))
(define (,(symbol-append tag 'vector-length) v)
(let ((len (* (uniform-vector-length v)
- (/ ,size (uniform-vector-element-size v)))))
+ (uniform-vector-element-size v)
+ (/ ,size))))
(if (integer? len)
len
(error "fractional length" v ',tag ,size))))
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 2e7f0d5f5..033e39f47 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -515,3 +515,28 @@
(pass-if-exception "generalized-vector-set!, out-of-range"
exception:out-of-range
(generalized-vector-set! (c64vector 1.0) 1 2.0)))
+
+(with-test-prefix "accessing uniform vectors of different types"
+
+ (pass-if "u32vector-length of u16vector"
+ (= 2 (u32vector-length (make-u16vector 4))))
+
+ (pass-if "u32vector-length of u8vector"
+ (= 2 (u32vector-length (make-u8vector 8))))
+
+ (pass-if "u8vector-length of u16vector"
+ (= 4 (u8vector-length (make-u16vector 2))))
+
+ (pass-if "u8vector-length of u32vector"
+ (= 8 (u8vector-length (make-u32vector 2))))
+
+ (pass-if "u32vector-set! of u16vector"
+ (let ((v (make-u16vector 4 #xFFFF)))
+ (u32vector-set! v 1 0)
+ (equal? v #u16(#xFFFF #xFFFF 0 0))))
+
+ (pass-if "u16vector-set! of u32vector"
+ (let ((v (make-u32vector 2 #xFFFFFFFF)))
+ (u16vector-set! v 2 0)
+ (u16vector-set! v 3 0)
+ (equal? v #u32(#xFFFFFFFF 0)))))