~ chicken-core (chicken-5) f825d98b52599bfd2c6048e23d144d2629a630df

commit f825d98b52599bfd2c6048e23d144d2629a630df
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Apr 22 13:34:34 2012 +0200
Commit:     Jim Ursetto <zbigniewsz@gmail.com>
CommitDate: Sun Apr 22 17:43:44 2012 -0500

    Fix DSSSL key arg handling in the presence of optional and rest args. Reported on IRC by R. Winkler
    
    Signed-off-by: Jim Ursetto <zbigniewsz@gmail.com>

diff --git a/expand.scm b/expand.scm
index 401234d6..e523a0cf 100644
--- a/expand.scm
+++ b/expand.scm
@@ -359,7 +359,7 @@
 				,(map (lambda (k)
 					(let ([s (car k)])
 					  `(,s (##sys#get-keyword
-						(##core#quote ,(->keyword (##sys#strip-syntax s))) ,rvar
+						(##core#quote ,(->keyword (##sys#strip-syntax s))) ,(or hasrest rvar)
 						,@(if (pair? (cdr k)) 
 						      `((,%lambda () ,@(cdr k)))
 						      '())))))
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index c1a2fa8f..17d533d9 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -764,6 +764,33 @@
 
 (assert (string=? "hello, XXX" (bar who: "XXX")))
 
+;;; DSSSL keyword arguments in various combinations with optional and rest args
+;;; reported on IRC by R. Winkler
+
+(define (test-optional&rest x y #!optional z #!rest r)
+  (list x y z r))
+
+(assert (equal? '(3 4 5 (6 7)) (test-optional&rest 3 4 5 6 7)))
+
+(define (test-optional&key x y #!optional z #!key i (j 1))
+  (list x y z i: i j: j))
+
+(assert (equal? '(3 4 5 i: 6 j: 7) (test-optional&key 3 4 5 i: 6 j: 7 8)))
+;; Unfortunate but correct (missing optional arg)
+(assert (equal? '(3 4 i: i: #f j: 1) (test-optional&key 3 4 i: 6 j: 7 8)))
+
+(define (test-key&rest x y #!rest r #!key i (j 1))
+  (list x y i: i j: j r))
+
+(assert (equal? '(3 4 i: 5 j: 1 (i: 5 6 7)) (test-key&rest 3 4 i: 5 6 7)))
+(assert (equal? '(3 4 i: 5 j: 6 (i: 5 j: 6 7 8))
+                (test-key&rest 3 4 i: 5 j: 6 7 8)))
+
+(define (test-optional-key&rest x y #!optional z #!rest r #!key i (j 1))
+  (list x y z i: i j: j r))
+
+(assert (equal? '(3 4 5 i: 6 j: 7 (i: 6 j: 7 8))
+                (test-optional-key&rest 3 4 5 i: 6 j: 7 8)))
 
 ;;; import not seen, if explicitly exported and renamed: