[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-254-gb24b7de

[Julian Graham]

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=b24b7deb000ee4108c5e3a0a2cb3d7494973a7a4

The branch, master has been updated
       via  b24b7deb000ee4108c5e3a0a2cb3d7494973a7a4 (commit)
      from  58daadd9825bf1db3e8958a8b41f6316ec3db7fd (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 b24b7deb000ee4108c5e3a0a2cb3d7494973a7a4
Author: Julian Graham <address@hidden>
Date:   Sun Aug 8 19:32:23 2010 -0400

    Explicit definitions for `vector-for-each' and `vector-map'; Guile's SRFI-1
    `for-each' and `map' implementations do not operate on lists and vectors
    interchangeably.
    
    * module/rnrs/base.scm (vector-for-each, vector-map): New functions.
    * test-suite/Makefile.am: Add test-suite/tests/r6rs-base.test to SCM_TESTS.
    * test-suite/tests/r6rs-base.test: New file.

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

Summary of changes:
 module/rnrs/base.scm                               |    7 ++++-
 test-suite/Makefile.am                             |    1 +
 .../tests/{r6rs-eval.test => r6rs-base.test}       |   21 ++++++++++++-------
 3 files changed, 19 insertions(+), 10 deletions(-)
 copy test-suite/tests/{r6rs-eval.test => r6rs-base.test} (64%)

diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 728afe4..e92089e 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -72,10 +72,13 @@
 
          syntax-rules identifier-syntax)
  (import (rename (guile) (quotient div) (modulo mod))
-        (rename (only (guile) for-each map)
-                (for-each vector-for-each) (map vector-map))
         (srfi srfi-11))
 
+ (define (vector-for-each proc . vecs)
+   (apply for-each (cons proc (map vector->list vecs))))
+ (define (vector-map proc . vecs)
+   (list->vector (apply map (cons proc (map vector->list vecs)))))
+
  (define (div-and-mod x y) (let ((q (div x y)) (r (mod x y))) (values q r)))
 
  (define (div0 x y)
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 9b52e3b..078df79 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -80,6 +80,7 @@ SCM_TESTS = tests/00-initial-env.test         \
            tests/r6rs-arithmetic-bitwise.test  \
            tests/r6rs-arithmetic-fixnums.test  \
            tests/r6rs-arithmetic-flonums.test  \
+           tests/r6rs-base.test                \
            tests/r6rs-conditions.test          \
            tests/r6rs-control.test             \
            tests/r6rs-enums.test               \
diff --git a/test-suite/tests/r6rs-eval.test b/test-suite/tests/r6rs-base.test
similarity index 64%
copy from test-suite/tests/r6rs-eval.test
copy to test-suite/tests/r6rs-base.test
index 30a2e00..05d5802 100644
--- a/test-suite/tests/r6rs-eval.test
+++ b/test-suite/tests/r6rs-base.test
@@ -1,4 +1,4 @@
-;;; r6rs-eval.test --- Test suite for R6RS (rnrs eval)
+;;; r6rs-base.test --- Test suite for R6RS (rnrs base)
 
 ;;      Copyright (C) 2010 Free Software Foundation, Inc.
 ;;
@@ -17,12 +17,17 @@
 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
-(define-module (test-suite test-rnrs-eval)
-  :use-module ((rnrs eval) :version (6))
+(define-module (test-suite test-r6rs-base)
+  :use-module ((rnrs base) :version (6))
   :use-module (test-suite lib))
 
-(with-test-prefix "environment"
-  (pass-if "simple"
-    (eqv? (eval '(eval:car (eval:cons 2 4))
-               (environment '(prefix (only (rnrs base) car cons) eval:)))
-         2)))
+(with-test-prefix "vector-for-each"
+  (pass-if "vector-for-each simple"
+    (let ((sum 0))
+      (vector-for-each (lambda (x) (set! sum (+ sum x))) '#(1 2 3))
+      (eqv? sum 6))))    
+
+(with-test-prefix "vector-map"
+  (pass-if "vector-map simple"
+    (equal? '#(3 2 1) (vector-map (lambda (x) (- 4 x)) '#(1 2 3)))))
+


hooks/post-receive
-- 
GNU Guile