mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix for-each bug detecting not-a-list

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-03-02 12:04:18 +01:00
parent 6bceec326f
commit 1a95246a39
2 changed files with 13 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

3
module/ice-9/boot-9.scm
View file

@ -923,7 +923,8 @@ for key @var{k}, then invoke @var{thunk}."
(scm-error 'wrong-type-arg "for-each" "Circular list: ~S" (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
(list l) #f)) (list l) #f))
(f (car hare)) (f (car hare))
(for-each1 (cdr hare) (cdr tortoise)))))) (for-each1 (cdr hare) (cdr tortoise)))
(for-each1 hare tortoise))))
(if (not (null? hare)) (if (not (null? hare))
(scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
(list l) #f))))) (list l) #f)))))

12
test-suite/tests/eval.test
View file

@ -1,5 +1,5 @@
;;;; eval.test --- tests guile's evaluator -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -218,6 +218,16 @@
(map + '(1 2) '(3))) (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 ;;; define with procedure-name
;;; ;;;