lloda pushed a commit to branch main
in repository guile.
commit 4daf4664cfe09eddd577537aa16da64ab1096c29
Author: Daniel Llorens <ll...@sarc.name>
AuthorDate: Fri Sep 29 16:49:57 2023 +0200
Add test for r7rs string-for-each
* test-suite/tests/r7rs.test: As stated.
* module/scheme/base.scm: Reindent and add minimal doc.
---
module/scheme/base.scm | 37 +++++++++++++++++++------------------
test-suite/tests/r7rs.test | 8 ++++++++
2 files changed, 27 insertions(+), 18 deletions(-)
diff --git a/module/scheme/base.scm b/module/scheme/base.scm
index 9ad16a371..477dd9c28 100644
--- a/module/scheme/base.scm
+++ b/module/scheme/base.scm
@@ -406,24 +406,25 @@
s*)))))
(define r7:string-for-each
- (case-lambda
- ((proc s) (string-for-each proc s))
- ((proc s1 s2)
- (let ((len (min (string-length s1)
- (string-length s2))))
- (let loop ((i 0))
- (when (< i len)
- (proc (string-ref s1 i)
- (string-ref s2 i))
- (loop (+ i 1))))))
- ((proc . strings)
- (let ((len (apply min (map string-length strings))))
- (let loop ((i 0))
- (when (< i len)
- (apply proc (map (lambda (s)
- (string-ref s i))
- strings))
- (loop (+ i 1))))))))
+ (case-lambda
+ "Like @code{for-each}, but takes strings instead of lists."
+ ((proc s) (string-for-each proc s))
+ ((proc s1 s2)
+ (let ((len (min (string-length s1)
+ (string-length s2))))
+ (let loop ((i 0))
+ (when (< i len)
+ (proc (string-ref s1 i)
+ (string-ref s2 i))
+ (loop (+ i 1))))))
+ ((proc . strings)
+ (let ((len (apply min (map string-length strings))))
+ (let loop ((i 0))
+ (when (< i len)
+ (apply proc (map (lambda (s)
+ (string-ref s i))
+ strings))
+ (loop (+ i 1))))))))
(define (bytevector . lis)
(u8-list->bytevector lis))
diff --git a/test-suite/tests/r7rs.test b/test-suite/tests/r7rs.test
index 1cc8cd31e..a092473f2 100644
--- a/test-suite/tests/r7rs.test
+++ b/test-suite/tests/r7rs.test
@@ -1773,6 +1773,14 @@
"abcde")
v))
+(test '(4 3 2 1)
+ (let ((v '()))
+ (string-for-each
+ (lambda (b c) (set! v (cons (- (char->integer b) (char->integer c)) v)))
+ "bdfh"
+ "abcde")
+ v))
+
(test '(0 1 4 9 16) (let ((v (make-list 5)))
(vector-for-each
(lambda (i) (list-set! v i (* i i)))
