>From d48f10f71b98cb14d03ac618b039fdcd95fe0fbf Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 22 Apr 2012 13:34:34 +0200 Subject: [PATCH] Fix DSSSL key arg handling in the presence of optional and rest args. Reported on IRC by R. Winkler --- expand.scm | 2 +- tests/syntax-tests.scm | 27 +++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletions(-) diff --git a/expand.scm b/expand.scm index 401234d..e523a0c 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 c1a2fa8..17d533d 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: -- 1.7.9.1