From 6e668cbb00be7e4d27b981cd47173f9eedd022e4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 17 Jul 2008 17:55:52 +0000
Subject: [PATCH] fix R6RS template handling of consecutive ellipses

svn: r10824
---
 collects/rnrs/syntax-case-6.ss     | 9 ++++++++-
 collects/tests/r6rs/syntax-case.ss | 8 ++++++++
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/collects/rnrs/syntax-case-6.ss b/collects/rnrs/syntax-case-6.ss
index 762d94fd8a..e12c014a4f 100644
--- a/collects/rnrs/syntax-case-6.ss
+++ b/collects/rnrs/syntax-case-6.ss
@@ -227,7 +227,14 @@
             (identifier? #'ellipses)
             (free-identifier=? #'ellipses #'(... ...)))
        (box (cons (loop #'expr #f #f)
-                  (loop #'rest #f #t)))]
+                  (let rloop ([rest #'rest])
+                    (syntax-case rest ()
+                      [(ellipses . rest)
+                       (and (identifier? #'ellipses)
+                            (free-identifier=? #'ellipses #'(... ...)))
+                       ;; keep going:
+                       (rloop #'rest)]
+                      [else (loop rest #f #t)]))))]
       [(a . b) (let ([a (loop #'a in-ellipses? #f)]
                      [b (loop #'b in-ellipses? counting?)])
                  (if (or a b counting?)
diff --git a/collects/tests/r6rs/syntax-case.ss b/collects/tests/r6rs/syntax-case.ss
index 7de66cf00f..a3bfbbe304 100644
--- a/collects/tests/r6rs/syntax-case.ss
+++ b/collects/tests/r6rs/syntax-case.ss
@@ -195,6 +195,14 @@
     (test (syntax-case #'(1) ()
             [(_) (syntax->datum #'_)])
           '_)
+    (test (syntax-case '((a) (b c)) ()
+            [((x ...) ...)
+             #'(x ... ...)])
+          '(a b c))
+    (test (syntax-case #'((a) (b c)) ()
+            [((x ...) ...)
+             (map syntax->datum #'(x ... ...))])
+          '(a b c))
 
     (test (identifier? 'x) #f)
     (test (identifier? #'x) #t)