From 30bf1aaa2d1a4cbce139fc04d7aae926cef2ea2d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Fri, 5 May 2017 21:39:05 +0200
Subject: [PATCH] Added tests for ~syntax-case, fixed stat-pattern in
 ~syntax-case: it should not escape the behaviour of _

---
 private/syntax-case-as-syntax-parse.rkt   | 14 ++------------
 test/test-syntax-case-as-syntax-parse.rkt | 18 ++++++++++++++++++
 2 files changed, 20 insertions(+), 12 deletions(-)
 create mode 100644 test/test-syntax-case-as-syntax-parse.rkt

diff --git a/private/syntax-case-as-syntax-parse.rkt b/private/syntax-case-as-syntax-parse.rkt
index cf9c4fa..cf7264a 100644
--- a/private/syntax-case-as-syntax-parse.rkt
+++ b/private/syntax-case-as-syntax-parse.rkt
@@ -1,6 +1,6 @@
 #lang racket/base
 (provide ~syntax-case ~syntax-case-stat)
-(require syntax/parse
+(require stxparse-info/parse
          (for-syntax racket/base))
 (define-for-syntax (~syntax-case-impl not-stat? stx)
   (with-syntax ([(_ stx1) stx])
@@ -22,7 +22,7 @@
         [()
          stx2]))
     (syntax-case #'stx1 ()
-      [underscore (and (id=? #'underscore #'_) not-stat?)
+      [underscore (id=? #'underscore #'_)
                   #'underscore]
       [id (identifier? #'id)
           (ds `{,{ds2 '~var #'id} ,#'id})]
@@ -49,17 +49,7 @@
       [other
        (ds `{,(ds2 '~datum #'other) ,#'other})])))
 
-#;(syntax-case (quote-syntax #s(a b c d)) ()
-    [#s(a ... bb) #'bb]
-    [(... #s(a ... b)) 'y])
-
 (define-syntax ~syntax-case
   (pattern-expander (λ (stx) (~syntax-case-impl #t stx))))
 (define-syntax ~syntax-case-stat
   (pattern-expander (λ (stx) (~syntax-case-impl #f stx))))
-
-#;(syntax-parse #'(1 2 3)
-    [{~syntax-case (~var ... ~and)}
-     (displayln (attribute ~var))
-     (displayln (attribute ~and))
-     ])
\ No newline at end of file
diff --git a/test/test-syntax-case-as-syntax-parse.rkt b/test/test-syntax-case-as-syntax-parse.rkt
new file mode 100644
index 0000000..ab48b87
--- /dev/null
+++ b/test/test-syntax-case-as-syntax-parse.rkt
@@ -0,0 +1,18 @@
+#lang racket/base
+(require rackunit
+         subtemplate/private/syntax-case-as-syntax-parse
+         stxparse-info/parse)
+(check-equal?
+ (syntax-parse #'(1 2 3)
+   [{~syntax-case (~var ... ~and)}
+    (list (map syntax->datum (attribute ~var))
+          (syntax->datum (attribute ~and)))
+    ])
+ '((1 2) 3))
+
+(check-equal?
+ (syntax-parse #'(1 2 3)
+   [{~syntax-case (... (_ _ _))}
+    ;; underscores are not escaped by (... pat)
+    (syntax->datum #'_)])
+ '_)
\ No newline at end of file