~ chicken-core (chicken-5) 1255242c962147a842e618da405a6c2597ce6ad8

commit 1255242c962147a842e618da405a6c2597ce6ad8
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon May 27 14:11:02 2013 +1200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sun Jun 16 21:04:29 2013 +0200

    verify syntax in => cond clauses
    
    This corrects cond's behavior given clauses of the form `(test =>)` or
    `(test => foo bar)`.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/expand.scm b/expand.scm
index 3688fa25..ea53d6b3 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1144,13 +1144,14 @@
 		     '(##core#begin))
 		    ((null? (cdr clause)) 
 		     `(,%or ,(car clause) ,(expand rclauses #f)))
-		    ((c %=> (cadr clause))
+		    ((and (fx= (length clause) 3)
+			  (c %=> (cadr clause)))
 		     (let ((tmp (r 'tmp)))
 		       `(##core#let ((,tmp ,(car clause)))
 				    (##core#if ,tmp
 					       (,(caddr clause) ,tmp)
 					       ,(expand rclauses #f) ) ) ) )
-		    ((and (list? clause) (fx= (length clause) 4)
+		    ((and (fx= (length clause) 4)
 			  (c %=> (caddr clause)))
 		     (let ((tmp (r 'tmp)))
 		       `(##sys#call-with-values
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 6da0277a..89cfd469 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -191,6 +191,14 @@
   (cond (#t => 'ok)))
 )
 
+(t 1 (let ((=> 1))
+       (cond (#f 'false)
+             (#t =>))))
+
+(t 3 (let ((=> 1))
+       (cond (#f 'false)
+             (#t => 2 3))))
+
 (t '(3 4)
 (let ((foo 3))
   (let-syntax ((bar (syntax-rules () ((_ x) (list foo x)))))