mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Fix `generalized-vector->list' indexing bug with shared arrays.

Browse source 
Fixes <http://bugs.gnu.org/12465>.
Reported by Daniel Llorens <daniel.llorens@bluewin.ch>.

* libguile/generalized-vectors.c (scm_generalized_vector_to_list): Fix
  initial value of POS; pass the `h.base + pos', not just `pos' as the
  `vref' argument.

* test-suite/tests/arrays.test ("array->list")["http://bugs.gnu.org/12465
  - ok", "http://bugs.gnu.org/12465 - bad]: New tests.
  ("generalized-vector->list"): New test prefix.
This commit is contained in:
Ludovic Courtès 2012-11-03 00:20:23 +01:00
parent 80aeb9af0d
commit 1d4e6ee301
2 changed files with 46 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/generalized-vectors.c
View file

@ -1,5 +1,6 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
*
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
* 2005, 2006, 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 License
* as published by the Free Software Foundation; either version 3 of
@ -178,14 +179,21 @@ SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
"generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_to_list
{
/* FIXME: This duplicates `array_to_list'. */
SCM ret = SCM_EOL;
ssize_t pos, i = 0;
long inc;
ssize_t pos, i;
scm_t_array_handle h;
scm_generalized_vector_get_handle (v, &h);
for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd);
i >= 0;
pos -= h.dims[0].inc, i--)
ret = scm_cons (h.impl->vref (&h, pos), ret);
i = h.dims[0].ubnd - h.dims[0].lbnd + 1;
inc = h.dims[0].inc;
pos = (i - 1) * inc;
for (; i > 0; i--, pos -= inc)
ret = scm_cons (h.impl->vref (&h, h.base + pos), ret);
scm_array_handle_release (&h);
return ret;
}

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

@ -214,8 +214,38 @@
(pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
(pass-if-equal '(1 2 3) (array->list #(1 2 3)))
(pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
(pass-if-equal '() (array->list #())))
(pass-if-equal '() (array->list #()))
(pass-if-equal "http://bugs.gnu.org/12465 - ok"
'(3 4)
(let* ((a #2((1 2) (3 4)))
(b (make-shared-array a (lambda (j) (list 1 j)) 2)))
(array->list b)))
(pass-if-equal "http://bugs.gnu.org/12465 - bad"
'(2 4)
(let* ((a #2((1 2) (3 4)))
(b (make-shared-array a (lambda (i) (list i 1)) 2)))
(array->list b))))
;;;
;;; generalized-vector->list
;;;
(with-test-prefix "generalized-vector->list"
(pass-if-equal '(1 2 3) (generalized-vector->list #s16(1 2 3)))
(pass-if-equal '(1 2 3) (generalized-vector->list #(1 2 3)))
(pass-if-equal '() (generalized-vector->list #()))
(pass-if-equal "http://bugs.gnu.org/12465 - ok"
'(3 4)
(let* ((a #2((1 2) (3 4)))
(b (make-shared-array a (lambda (j) (list 1 j)) 2)))
(generalized-vector->list b)))
(pass-if-equal "http://bugs.gnu.org/12465 - bad"
'(2 4)
(let* ((a #2((1 2) (3 4)))
(b (make-shared-array a (lambda (i) (list i 1)) 2)))
(generalized-vector->list b))))
;;;
;;; array-fill!