~ 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