[Guile-commits] GNU Guile branch, master, updated. v2.1.0-800-g3c3de73

[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=3c3de73d4da32d2ae6371134a26449302524b8e0

The branch, master has been updated
       via  3c3de73d4da32d2ae6371134a26449302524b8e0 (commit)
       via  1a95246a39ad63d8bd3bcdd05b08cb469a922841 (commit)
      from  6bceec326f84850b680f41ac18b9173007dda395 (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 3c3de73d4da32d2ae6371134a26449302524b8e0
Author: Andy Wingo <address@hidden>
Date:   Sun Mar 2 12:05:32 2014 +0100

    Port unrolled one-argument for-each from boot-9 to srfi-1
    
    * module/srfi/srfi-1.scm (for-each): Port unrolled one-argument
      implementation here from the boot-9 version.

commit 1a95246a39ad63d8bd3bcdd05b08cb469a922841
Author: Andy Wingo <address@hidden>
Date:   Sun Mar 2 12:04:18 2014 +0100

    Fix for-each bug detecting not-a-list
    
    * module/ice-9/boot-9.scm (for-each): Fix detection of not-a-list in the
      unrolled one-argument case.
    
    * test-suite/tests/eval.test ("for-each"): Add a test.

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

Summary of changes:
 module/ice-9/boot-9.scm    |    3 ++-
 module/srfi/srfi-1.scm     |   23 ++++++++++++-----------
 test-suite/tests/eval.test |   12 +++++++++++-
 3 files changed, 25 insertions(+), 13 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index fd92445..f9a7c1f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -923,7 +923,8 @@ for key @var{k}, then invoke @var{thunk}."
                        (scm-error 'wrong-type-arg "for-each" "Circular list: 
~S"
                                   (list l) #f))
                      (f (car hare))
-                     (for-each1 (cdr hare) (cdr tortoise))))))
+                     (for-each1 (cdr hare) (cdr tortoise)))
+                   (for-each1 hare tortoise))))
            (if (not (null? hare))
                (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
                           (list l) #f)))))
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index d2531b5..74b01bc 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -1,6 +1,6 @@
 ;;; srfi-1.scm --- List Library
 
-;;     Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011 Free 
Software Foundation, Inc.
+;;     Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 
2014 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,22 +606,23 @@ has just one element then that's the return value."
   (case-lambda
     ((f l)
      (check-arg procedure? f for-each)
-     (let for-each1 ((hare l) (tortoise l) (move? #f))
+     (let for-each1 ((hare l) (tortoise l))
        (if (pair? hare)
-           (if move?
-               (if (eq? tortoise hare)
-                   (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
-                              (list l) #f)
+           (begin
+             (f (car hare))
+             (let ((hare (cdr hare)))
+               (if (pair? hare)
                    (begin
+                     (when (eq? tortoise hare)
+                       (scm-error 'wrong-type-arg "for-each" "Circular list: 
~S"
+                                  (list l) #f))
                      (f (car hare))
-                     (for-each1 (cdr hare) (cdr tortoise) #f)))
-               (begin
-                 (f (car hare))
-                 (for-each1 (cdr hare) tortoise #t)))
-           
+                     (for-each1 (cdr hare) (cdr tortoise)))
+                   (for-each1 hare tortoise))))
            (if (not (null? hare))
                (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
                           (list l) #f)))))
+
     
     ((f l1 . rest)
      (check-arg procedure? f for-each)
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 2e0a767..3fc1d94 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -1,5 +1,5 @@
 ;;;; eval.test --- tests guile's evaluator     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011, 2012, 2013 Free 
Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 2014 
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
@@ -218,6 +218,16 @@
        (map + '(1 2) '(3)))
     )))
 
+(with-test-prefix "for-each"
+
+  (pass-if-exception "1 arg, non-list, even number of elements"
+      exception:not-a-list
+    (for-each values '(1 2 3 4 . 5)))
+
+  (pass-if-exception "1 arg, non-list, odd number of elements"
+      exception:not-a-list
+    (for-each values '(1 2 3 . 4))))
+
 ;;;
 ;;; define with procedure-name
 ;;;


hooks/post-receive
-- 
GNU Guile