On Sun, Jun 30, 2013 at 03:10:59PM +0200, Peter Bex wrote: > On Mon, Jun 24, 2013 at 11:34:02AM +0200, Michele La Monaca wrote: > > I think it's dangerous to leave it as it is. For example: > > > > #;3> (and-let* (((or #f #t))) 1) ;; correct > > 1 > > #;4> (and-let* ((or #f #t)) 1) ;; WRONG! -> a stricter syntax > > would catch this error > > #f > > I agree this type of mistake should be caught. Attached is a patch > that fixes this (and adds a test for it). > > Thanks for reporting this bug!
Of course I forgot the attachment... Cheers, Peter -- http://www.more-magic.net
>From 63ca1ba40774865cfe9931b1580c2e00ddf6a155 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 30 Jun 2013 15:11:37 +0200 Subject: [PATCH] Make and-let* check its syntax strictly instead of silently discarding forms. Reported by Michele La Monaca --- chicken-syntax.scm | 1 + tests/syntax-tests.scm | 15 ++++++++++++++- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 06570db..ce1bdf6 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 89cfd46..c496270 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))) -- 1.8.2.3
_______________________________________________ Chicken-users mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-users
