diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c index b65b654fb..d8a3bf8d3 100644 --- a/libguile/generalized-vectors.c +++ b/libguile/generalized-vectors.c @@ -131,9 +131,11 @@ SCM scm_c_generalized_vector_ref (SCM v, size_t idx) { scm_t_array_handle h; + size_t pos; SCM ret; scm_generalized_vector_get_handle (v, &h); - ret = h.impl->vref (&h, idx); + pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc; + ret = h.impl->vref (&h, pos); scm_array_handle_release (&h); return ret; } @@ -152,8 +154,10 @@ void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val) { scm_t_array_handle h; + size_t pos; scm_generalized_vector_get_handle (v, &h); - h.impl->vset (&h, idx, val); + pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc; + h.impl->vset (&h, pos, val); scm_array_handle_release (&h); } diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index b762f2014..b6eee7c3d 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -1,6 +1,6 @@ ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; -;;;; Copyright 2004, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright 2004, 2006, 2009, 2010, 2011 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 @@ -606,3 +606,19 @@ (lambda (i) (list i i)) '(0 2)) #(a e i)))) + +;;; +;;; slices as generalized vectors +;;; + +(let ((array #2u32((0 1) (2 3)))) + (define (array-row a i) + (make-shared-array a (lambda (j) (list i j)) + (cadr (array-dimensions a)))) + (with-test-prefix "generalized vector slices" + (pass-if (equal? (array-row array 1) + #u32(2 3))) + (pass-if (equal? (array-ref (array-row array 1) 0) + 2)) + (pass-if (equal? (generalized-vector-ref (array-row array 1) 0) + 2))))