[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-93-g848431b

[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=848431b6b296c22cd3892ad4a70ff605f00fe060

The branch, stable-2.0 has been updated
       via  848431b6b296c22cd3892ad4a70ff605f00fe060 (commit)
       via  2b414e247fcf28b9431a326b59decebbe859bdb8 (commit)
      from  ba20d2629eea673b10c74c1f8168821709ed3807 (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 848431b6b296c22cd3892ad4a70ff605f00fe060
Author: Daniel Llorens <address@hidden>
Date:   Thu Dec 22 17:13:07 2011 -0500

    New array-map! and array-for-each tests
    
    * ramap.test: New tests.
      - array-map! with noncompact arrays and more than one argument.
      - array-for-each with noncompact arrays and more than two arguments.

commit 2b414e247fcf28b9431a326b59decebbe859bdb8
Author: Andy Wingo <address@hidden>
Date:   Thu Dec 22 17:03:04 2011 -0500

    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.

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

Summary of changes:
 libguile/generalized-vectors.c |    8 +++-
 test-suite/tests/arrays.test   |   18 +++++++++-
 test-suite/tests/ramap.test    |   73 +++++++++++++++++++++++++++++++++++++++-
 3 files changed, 95 insertions(+), 4 deletions(-)

diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index b65b654..d8a3bf8 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 b762f20..b6eee7c 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))))
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index e3a65ae..5b99f72 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -19,6 +19,14 @@
 (define-module (test-suite test-ramap)
   #:use-module (test-suite lib))
 
+(define (array-row a i)
+  (make-shared-array a (lambda (j) (list i j))
+                       (cadr (array-dimensions a))))
+
+(define (array-col a j)
+  (make-shared-array a (lambda (i) (list i j))
+                       (car (array-dimensions a))))
+
 ;;;
 ;;; array-index-map!
 ;;;
@@ -183,4 +191,67 @@
     (pass-if "+"
       (let ((a (make-array #f 4)))
        (array-map! a + #(1 2 3 4) #(5 6 7 8))
-       (equal? a #(6 8 10 12))))))
+       (equal? a #(6 8 10 12))))
+        
+    (pass-if "noncompact arrays 1"
+      (let ((a #2((0 1) (2 3)))
+            (c #(0 0)))
+        (begin
+          (array-map! c + (array-row a 1) (array-row a 1))
+          (array-equal? c #(4 6)))))
+          
+    (pass-if "noncompact arrays 2"
+      (let ((a #2((0 1) (2 3)))
+            (c #(0 0)))
+        (begin
+          (array-map! c + (array-col a 1) (array-col a 1))
+          (array-equal? c #(2 6)))))
+          
+    (pass-if "noncompact arrays 3"
+      (let ((a #2((0 1) (2 3)))
+            (c #(0 0)))
+        (begin
+          (array-map! c + (array-col a 1) (array-row a 1))
+          (array-equal? c #(3 6)))))
+          
+    (pass-if "noncompact arrays 4"
+      (let ((a #2((0 1) (2 3)))
+            (c #(0 0)))
+        (begin
+          (array-map! c + (array-col a 1) (array-row a 1))
+          (array-equal? c #(3 6)))))))
+
+;;;
+;;; array-for-each
+;;;
+
+(with-test-prefix "array-for-each"
+
+  (with-test-prefix "3 sources"
+    (pass-if "noncompact arrays 1"
+      (let* ((a #2((0 1) (2 3)))
+             (l '())
+             (rec (lambda args (set! l (cons args l)))))
+        (array-for-each rec (array-row a 1) (array-row a 1) (array-row a 1))
+        (equal? l '((3 3 3) (2 2 2)))))
+          
+    (pass-if "noncompact arrays 2"
+      (let* ((a #2((0 1) (2 3)))
+             (l '())
+             (rec (lambda args (set! l (cons args l)))))
+        (array-for-each rec (array-row a 1) (array-row a 1) (array-col a 1))
+        (equal? l '((3 3 3) (2 2 1)))))
+          
+    (pass-if "noncompact arrays 3"
+      (let* ((a #2((0 1) (2 3)))
+             (l '())
+             (rec (lambda args (set! l (cons args l)))))
+        (array-for-each rec (array-row a 1) (array-col a 1) (array-col a 1))
+        (equal? l '((3 3 3) (2 1 1)))))
+          
+    (pass-if "noncompact arrays 4"
+      (let* ((a #2((0 1) (2 3)))
+             (l '())
+             (rec (lambda args (set! l (cons args l)))))
+        (array-for-each rec (array-col a 1) (array-col a 0) (array-row a 1))
+        (equal? l '((3 2 3) (1 0 2)))))))


hooks/post-receive
-- 
GNU Guile