~ chicken-core (chicken-5) 9bb86f98900759d74be4aeec9f3f42221e0ac82e
commit 9bb86f98900759d74be4aeec9f3f42221e0ac82e
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Jun 30 15:11:37 2013 +0200
Commit: Mario Domenech Goulart <mario.goulart@gmail.com>
CommitDate: Sun Jun 30 13:55:59 2013 -0300
Make and-let* check its syntax strictly instead of silently discarding forms. Reported by Michele La Monaca
Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 06570db5..ce1bdf6d 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -489,6 +489,7 @@
(cond [(not (pair? b)) `(##core#if ,b ,(fold bs2) #f)]
[(null? (cdr b)) `(##core#if ,(car b) ,(fold bs2) #f)]
[else
+ (##sys#check-syntax 'and-let* b '(symbol _))
(let ((var (car b)))
`(##core#let ((,var ,(cadr b)))
(##core#if ,var ,(fold bs2) #f) ) ) ] ) ) ) ) ) ) ) )
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 89cfd469..c4962700 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -851,6 +851,19 @@
(import scheme)
(define (always-two) (+ (one#always-one) 1)))))
+;;; SRFI-2 (and-let*)
+
+(t 1 (and-let* ((a 1)) a))
+(f (eval '(and-let* ((a 1 2 3)) a)))
+(t 2 (and-let* ((a 1) (b (+ a 1))) b))
+(t 3 (and-let* (((or #f #t))) 3))
+(f (eval '(and-let* ((or #f #t)) 1)))
+(t 4 (and-let* ((c 4) ((equal? 4 c))) c))
+(t #f (and-let* ((c 4) ((equal? 5 c))) (error "not reached")))
+(t #f (and-let* (((= 4 5)) ((error "not reached 1"))) (error "not reached 2")))
+(t 'foo (and-let* (((= 4 4)) (a 'foo)) a))
+(t #f (and-let* ((a #f) ((error "not reached 1"))) (error "not reached 2")))
+
;;; SRFI-26
;; Cut
@@ -1086,4 +1099,4 @@ take
(syntax-rules ()
((_) (begin (define req 2) (display req) (newline)))))
(bar)
- (assert (eq? req 1)))
\ No newline at end of file
+ (assert (eq? req 1)))
Trap