fix generalized-vector-{ref,set!} for slices

* libguile/generalized-vectors.c (scm_c_generalized_vector_ref):
  (scm_c_generalized_vector_set_x): Fix for the case in which base was
  not 1, lbnd was not 0, or inc was not 1.

* test-suite/tests/arrays.test (array): Add a test.  Thanks to Daniel
  Llorens for the report.

2 files changed, 23 insertions, 3 deletions

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