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 generalized-vector-{ref,set!} for slices

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-12-22 17:03:04 -05:00
parent ba20d2629e
commit 2b414e247f
2 changed files with 23 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/generalized-vectors.c
View file

@ -131,9 +131,11 @@ SCM
scm_c_generalized_vector_ref (SCM v, size_t idx) scm_c_generalized_vector_ref (SCM v, size_t idx)
{ {
scm_t_array_handle h; scm_t_array_handle h;
size_t pos;
SCM ret; SCM ret;
scm_generalized_vector_get_handle (v, &h); 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); scm_array_handle_release (&h);
return ret; return ret;
} }
@ -152,8 +154,10 @@ void
scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val) scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
{ {
scm_t_array_handle h; scm_t_array_handle h;
size_t pos;
scm_generalized_vector_get_handle (v, &h); 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); scm_array_handle_release (&h);
} }

18
test-suite/tests/arrays.test
View file

@ -1,6 +1,6 @@
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -606,3 +606,19 @@
(lambda (i) (list i i)) (lambda (i) (list i i))
'(0 2)) '(0 2))
#(a e i)))) #(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))))