[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-61-g09834e4

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=09834e439b685ca3bb4404e40e046b11772fe50d

The branch, master has been updated
       via  09834e439b685ca3bb4404e40e046b11772fe50d (commit)
      from  edb7bb4766773cffa8262b4cd8bb980888913d65 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 09834e439b685ca3bb4404e40e046b11772fe50d
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 3 12:36:37 2010 +0100

    fix bug in generalized-vector->list
    
    * libguile/generalized-vectors.c (scm_generalized_vector_to_list): Fix
      bug iterating over indices of array. Thanks to Tristan Colgate for the
      report.
    
    * test-suite/tests/srfi-4.test: Add tests that uniform-vector->list
      works for all kinds of uniform vectors.

-----------------------------------------------------------------------

Summary of changes:
 libguile/generalized-vectors.c |    7 ++--
 test-suite/tests/srfi-4.test   |   62 ++++++++++++++++++++++++++++++++-------
 2 files changed, 54 insertions(+), 15 deletions(-)

diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 4e3b924..bb53dda 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010 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
@@ -178,10 +178,9 @@ SCM_DEFINE (scm_generalized_vector_to_list, 
"generalized-vector->list", 1, 0, 0,
   ssize_t pos, i = 0;
   scm_t_array_handle h;
   scm_generalized_vector_get_handle (v, &h);
-  /* FIXME CHECKME */
-  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
+  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd);
        i >= 0;
-       pos += h.dims[0].inc)
+       pos -= h.dims[0].inc, i--)
     ret = scm_cons (h.impl->vref (&h, pos), ret);
   scm_array_handle_release (&h);
   return ret;
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 8a9d53a..8251884 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -1,7 +1,7 @@
 ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
 ;;;; Martin Grabmueller, 2001-06-26
 ;;;;
-;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2010 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
@@ -47,7 +47,11 @@
 
   (pass-if "u8vector->list/list->u8vector"
     (equal? (u8vector->list (u8vector 1 2 3 4))
-           (u8vector->list (list->u8vector '(1 2 3 4))))))
+           (u8vector->list (list->u8vector '(1 2 3 4)))))
+
+  (pass-if "u8vector->list/uniform-vector->list"
+    (equal? (u8vector->list (u8vector 1 2 3 4))
+           (uniform-vector->list (u8vector 1 2 3 4)))))
 
 (with-test-prefix "s8 vectors"
 
@@ -76,7 +80,11 @@
 
   (pass-if "s8vector->list/list->s8vector"
     (equal? (s8vector->list (s8vector 1 2 3 4))
-           (s8vector->list (list->s8vector '(1 2 3 4))))))
+           (s8vector->list (list->s8vector '(1 2 3 4)))))
+
+  (pass-if "s8vector->list/uniform-vector->list"
+    (equal? (s8vector->list (s8vector 1 2 3 4))
+           (uniform-vector->list (s8vector 1 2 3 4)))))
 
 
 (with-test-prefix "u16 vectors"
@@ -106,7 +114,11 @@
 
   (pass-if "u16vector->list/list->u16vector"
     (equal? (u16vector->list (u16vector 1 2 3 4))
-           (u16vector->list (list->u16vector '(1 2 3 4))))))
+           (u16vector->list (list->u16vector '(1 2 3 4)))))
+
+  (pass-if "u16vector->list/uniform-vector->list"
+    (equal? (u16vector->list (u16vector 1 2 3 4))
+           (uniform-vector->list (u16vector 1 2 3 4)))))
 
 (with-test-prefix "s16 vectors"
 
@@ -135,7 +147,11 @@
 
   (pass-if "s16vector->list/list->s16vector"
     (equal? (s16vector->list (s16vector 1 2 3 4))
-           (s16vector->list (list->s16vector '(1 2 3 4))))))
+           (s16vector->list (list->s16vector '(1 2 3 4)))))
+
+  (pass-if "s16vector->list/uniform-vector->list"
+    (equal? (s16vector->list (s16vector 1 2 3 4))
+           (uniform-vector->list (s16vector 1 2 3 4)))))
 
 (with-test-prefix "u32 vectors"
 
@@ -164,7 +180,11 @@
 
   (pass-if "u32vector->list/list->u32vector"
     (equal? (u32vector->list (u32vector 1 2 3 4))
-           (u32vector->list (list->u32vector '(1 2 3 4))))))
+           (u32vector->list (list->u32vector '(1 2 3 4)))))
+
+  (pass-if "u32vector->list/uniform-vector->list"
+    (equal? (u32vector->list (u32vector 1 2 3 4))
+           (uniform-vector->list (u32vector 1 2 3 4)))))
 
 (with-test-prefix "s32 vectors"
 
@@ -193,7 +213,11 @@
 
   (pass-if "s32vector->list/list->s32vector"
     (equal? (s32vector->list (s32vector 1 2 3 4))
-           (s32vector->list (list->s32vector '(1 2 3 4))))))
+           (s32vector->list (list->s32vector '(1 2 3 4)))))
+
+  (pass-if "s32vector->list/uniform-vector->list"
+    (equal? (s32vector->list (s32vector 1 2 3 4))
+           (uniform-vector->list (s32vector 1 2 3 4)))))
 
 (with-test-prefix "u64 vectors"
 
@@ -222,7 +246,11 @@
 
   (pass-if "u64vector->list/list->u64vector"
     (equal? (u64vector->list (u64vector 1 2 3 4))
-           (u64vector->list (list->u64vector '(1 2 3 4))))))
+           (u64vector->list (list->u64vector '(1 2 3 4)))))
+
+  (pass-if "u64vector->list/uniform-vector->list"
+    (equal? (u64vector->list (u64vector 1 2 3 4))
+           (uniform-vector->list (u64vector 1 2 3 4)))))
 
 (with-test-prefix "s64 vectors"
 
@@ -251,7 +279,11 @@
 
   (pass-if "s64vector->list/list->s64vector"
     (equal? (s64vector->list (s64vector 1 2 3 4))
-           (s64vector->list (list->s64vector '(1 2 3 4))))))
+           (s64vector->list (list->s64vector '(1 2 3 4)))))
+
+  (pass-if "s64vector->list/uniform-vector->list"
+    (equal? (s64vector->list (s64vector 1 2 3 4))
+           (uniform-vector->list (s64vector 1 2 3 4)))))
 
 (with-test-prefix "f32 vectors"
 
@@ -280,7 +312,11 @@
 
   (pass-if "f32vector->list/list->f32vector"
     (equal? (f32vector->list (f32vector 1 2 3 4))
-           (f32vector->list (list->f32vector '(1 2 3 4))))))
+           (f32vector->list (list->f32vector '(1 2 3 4)))))
+
+  (pass-if "f32vector->list/uniform-vector->list"
+    (equal? (f32vector->list (f32vector 1 2 3 4))
+           (uniform-vector->list (f32vector 1 2 3 4)))))
 
 (with-test-prefix "f64 vectors"
 
@@ -309,4 +345,8 @@
 
   (pass-if "f64vector->list/list->f64vector"
     (equal? (f64vector->list (f64vector 1 2 3 4))
-           (f64vector->list (list->f64vector '(1 2 3 4))))))
+           (f64vector->list (list->f64vector '(1 2 3 4)))))
+
+  (pass-if "f64vector->list/uniform-vector->list"
+    (equal? (f64vector->list (f64vector 1 2 3 4))
+           (uniform-vector->list (f64vector 1 2 3 4)))))


hooks/post-receive
-- 
GNU Guile