www

commit 30bf1aaa2d1a4cbce139fc04d7aae926cef2ea2d
parent 8bf9e48c025e37d0ada0421c787946a915e278d0
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Fri,  5 May 2017 21:39:05 +0200

Added tests for ~syntax-case, fixed stat-pattern in ~syntax-case: it should not escape the behaviour of _

Diffstat:
M
private/syntax-case-as-syntax-parse.rkt
 | 
15
++-------------
A
test/test-syntax-case-as-syntax-parse.rkt
 | 
19
+++++++++++++++++++

2 files changed, 21 insertions(+), 13 deletions(-)
diff --git 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
@@ -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