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

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.

2 files changed, 46 insertions, 8 deletions

diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index d8a3bf8d3..4da0e884f 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -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;
 }
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index cf0983221..f13b1a2ac 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -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!