commit bff27464a981cdb9ef3b4edd0f8b8d7eed08ced1
parent ad27231d00c9bdae618e0b8af5121d31a9bfd38f
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Thu, 26 Jan 2017 17:35:22 +0100
Bugfix and tests for define/with-syntax
Diffstat:
3 files changed, 186 insertions(+), 151 deletions(-)
diff --git a/case/syntax.rkt b/case/syntax.rkt
@@ -47,7 +47,7 @@
(define-syntax pvar
(make-syntax-mapping 'depth (quote-syntax valvar)))
...
- (define-pvars (pvar ...)))))]))
+ (define-pvars pvar ...))))]))
;; Ryan: alternative name: define/syntax-pattern ??
;; auxiliary macro
diff --git a/parse/experimental/private/substitute.rkt b/parse/experimental/private/substitute.rkt
@@ -60,13 +60,16 @@ An VarRef is one of
;; Used to indicate absent pvar in template; ?? catches
;; Note: not an exn, don't need continuation marks
(require (only-in rackunit require/expose))
-(require/expose syntax/parse/experimental/private/substitute
- (absent-pvar
- absent-pvar?
- absent-pvar-ctx
- absent-pvar-v
- absent-pvar-wanted-list?))
-#;(struct absent-pvar (ctx v wanted-list?))
+#;(require/expose syntax/parse/experimental/private/substitute
+ (absent-pvar
+ absent-pvar?
+ absent-pvar-ctx
+ absent-pvar-v
+ absent-pvar-wanted-list?))
+;; this struct is only used in this file, and is not exported, so I guess it's
+;; ok to not steal the struct from syntax/parse/experimental/private/substitute
+;; Furthermore, the require/expose above does not work reliably.
+(struct absent-pvar (ctx v wanted-list?))
;; ============================================================
diff --git a/test/test-current-pvars.rkt b/test/test-current-pvars.rkt
@@ -1,5 +1,6 @@
#lang racket
(require stxparse-info/parse
+ stxparse-info/case
stxparse-info/current-pvars
racket/stxparam
rackunit)
@@ -78,158 +79,188 @@
(syntax->datum (ref-nth-pvar 1)))]))])
'(1 2 1)))
-;; tests for define/syntax-parse
+;; Tests for syntax-case
(begin
- (check-equal? (syntax-parse #'1
- [x
- #:with y #'2
- (define/syntax-parse z #'3)
+ (check-equal? (list-pvars)
+ '())
+
+ (check-equal? (syntax-case #'(1 (2 3) a b c) ()
+ [(x (y ...) z ...)
(list-pvars)])
'(z y x))
- (check-equal? (syntax-parse #'1
- [x
- #:with y #'2
- (define/syntax-parse z #'3)
- (list (syntax->datum (ref-nth-pvar 0))
- (syntax->datum (ref-nth-pvar 1))
- (syntax->datum (ref-nth-pvar 2)))])
- '(3 2 1))
+ (check-equal? (list-pvars)
+ '())
(check-equal? (syntax-parse #'1
[x
- #:with y #'2
- (define/syntax-parse x #'3)
- (list-pvars)])
- '(x y x))
+ (syntax->datum (ref-nth-pvar 0))])
+ 1)
(check-equal? (syntax-parse #'1
[x
- #:with y #'2
- (define/syntax-parse x #'3)
- (list (syntax->datum (ref-nth-pvar 0))
- (syntax->datum (ref-nth-pvar 1))
- (syntax->datum (ref-nth-pvar 2)))])
- '(3 2 1))
+ (cons (syntax->datum (ref-nth-pvar 0))
+ (syntax-parse #'2
+ [x
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1)))]))])
+ '(1 2 1)))
- (check-equal? (syntax-parse #'1
- [x
- #:with y #'2
- (define/syntax-parse x #'3)
- (define/syntax-parse y #'4)
- (list (syntax->datum (ref-nth-pvar 0))
- (syntax->datum (ref-nth-pvar 1))
- (syntax->datum (ref-nth-pvar 2))
- (syntax->datum (ref-nth-pvar 3)))])
- '(4 3 2 1))
+;; tests for define/syntax-parse and define/syntax-case
+(define-syntax-rule (gen-test-define define/xxx)
+ (begin
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx z #'3)
+ (list-pvars)])
+ '(z y x))
+
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx z #'3)
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1))
+ (syntax->datum (ref-nth-pvar 2)))])
+ '(3 2 1))
+
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx x #'3)
+ (list-pvars)])
+ '(x y x))
+
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx x #'3)
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1))
+ (syntax->datum (ref-nth-pvar 2)))])
+ '(3 2 1))
+
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx x #'3)
+ (define/xxx y #'4)
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1))
+ (syntax->datum (ref-nth-pvar 2))
+ (syntax->datum (ref-nth-pvar 3)))])
+ '(4 3 2 1))
- (check-equal? (syntax-parse #'1
- [x
- #:with y #'2
- (define/syntax-parse x #'3)
- (define/syntax-parse y #'4)
- (define/syntax-parse z #'5)
- (list (syntax->datum (ref-nth-pvar 0))
- (syntax->datum (ref-nth-pvar 1))
- (syntax->datum (ref-nth-pvar 2))
- (syntax->datum (ref-nth-pvar 3))
- (syntax->datum (ref-nth-pvar 4)))])
- '(5 4 3 2 1))
-
- (check-equal? (syntax-parse #'(1 2 3)
- [(x y z)
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'5)
- (list (syntax->datum (ref-nth-pvar 0))
- (syntax->datum (ref-nth-pvar 1))
- (syntax->datum (ref-nth-pvar 2))
- (syntax->datum (ref-nth-pvar 3))
- (syntax->datum (ref-nth-pvar 4)))])
- '(5 4 3 2 1))
-
- (check-equal? (syntax-parse #'(1 2 3)
- [(x y z)
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'5)
- (list-pvars)])
- '(y x z y x))
-
- ;; Test with nested let, less variables in the nested let
- (check-equal? (let ()
- (define/syntax-parse w #'1)
- (define/syntax-parse x #'2)
- (define/syntax-parse y #'3)
- (define/syntax-parse z #'4)
- (list (list-pvars)
- (let ()
- (define/syntax-parse w #'5)
- (define/syntax-parse x #'6)
- (list-pvars))
- (list-pvars)))
- '((z y x w) (x w z y x w) (z y x w)))
-
- ;; Test with nested let, more variables in the nested let
- (check-equal? (let ()
- (define/syntax-parse w #'1)
- (define/syntax-parse x #'2)
- (list (list-pvars)
- (let ()
- (define/syntax-parse w #'3)
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'5)
- (define/syntax-parse z #'6)
- (list-pvars))
- (list-pvars)))
- '((x w) (z y x w x w) (x w)))
-
- (check-equal? (let ()
- (define/syntax-parse w #'1)
- (define/syntax-parse x #'2)
- (define/syntax-parse y #'3)
- (define/syntax-parse z #'4)
- (list (list-pvars)
- (syntax-parse #'5
- [k
- (define/syntax-parse w #'5)
- (define/syntax-parse x #'6)
- (list-pvars)])
- (list-pvars)))
- '((z y x w) (x w k z y x w) (z y x w)))
-
- (check-equal? (let ()
- (define/syntax-parse w #'1)
- (define/syntax-parse x #'2)
- (list (list-pvars)
- (syntax-parse #'5
- [k
- (define/syntax-parse w #'3)
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'5)
- (define/syntax-parse z #'6)
- (list-pvars)])
- (list-pvars)))
- '((x w) (z y x w k x w) (x w)))
-
- (check-equal? (let ()
- (define/syntax-parse w #'1)
- (define/syntax-parse x #'2)
- (list (list-pvars)
- (syntax-parse #'5
- [k
- (define/syntax-parse w #'3)
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'5)
- (define/syntax-parse z #'6)
- (list (list-pvars)
- (syntax-parse #'5
- [k
- (define/syntax-parse x #'4)
- (define/syntax-parse y #'4)
- (list-pvars)])
- (list-pvars))])
- (list-pvars)))
- '((x w)
- ((z y x w k x w)
- (y x k z y x w k x w)
- (z y x w k x w))
- (x w))))
+ (check-equal? (syntax-parse #'1
+ [x
+ #:with y #'2
+ (define/xxx x #'3)
+ (define/xxx y #'4)
+ (define/xxx z #'5)
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1))
+ (syntax->datum (ref-nth-pvar 2))
+ (syntax->datum (ref-nth-pvar 3))
+ (syntax->datum (ref-nth-pvar 4)))])
+ '(5 4 3 2 1))
+
+ (check-equal? (syntax-parse #'(1 2 3)
+ [(x y z)
+ (define/xxx x #'4)
+ (define/xxx y #'5)
+ (list (syntax->datum (ref-nth-pvar 0))
+ (syntax->datum (ref-nth-pvar 1))
+ (syntax->datum (ref-nth-pvar 2))
+ (syntax->datum (ref-nth-pvar 3))
+ (syntax->datum (ref-nth-pvar 4)))])
+ '(5 4 3 2 1))
+
+ (check-equal? (syntax-parse #'(1 2 3)
+ [(x y z)
+ (define/xxx x #'4)
+ (define/xxx y #'5)
+ (list-pvars)])
+ '(y x z y x))
+
+ ;; Test with nested let, less variables in the nested let
+ (check-equal? (let ()
+ (define/xxx w #'1)
+ (define/xxx x #'2)
+ (define/xxx y #'3)
+ (define/xxx z #'4)
+ (list (list-pvars)
+ (let ()
+ (define/xxx w #'5)
+ (define/xxx x #'6)
+ (list-pvars))
+ (list-pvars)))
+ '((z y x w) (x w z y x w) (z y x w)))
+
+ ;; Test with nested let, more variables in the nested let
+ (check-equal? (let ()
+ (define/xxx w #'1)
+ (define/xxx x #'2)
+ (list (list-pvars)
+ (let ()
+ (define/xxx w #'3)
+ (define/xxx x #'4)
+ (define/xxx y #'5)
+ (define/xxx z #'6)
+ (list-pvars))
+ (list-pvars)))
+ '((x w) (z y x w x w) (x w)))
+
+ (check-equal? (let ()
+ (define/xxx w #'1)
+ (define/xxx x #'2)
+ (define/xxx y #'3)
+ (define/xxx z #'4)
+ (list (list-pvars)
+ (syntax-parse #'5
+ [k
+ (define/xxx w #'5)
+ (define/xxx x #'6)
+ (list-pvars)])
+ (list-pvars)))
+ '((z y x w) (x w k z y x w) (z y x w)))
+
+ (check-equal? (let ()
+ (define/xxx w #'1)
+ (define/xxx x #'2)
+ (list (list-pvars)
+ (syntax-parse #'5
+ [k
+ (define/xxx w #'3)
+ (define/xxx x #'4)
+ (define/xxx y #'5)
+ (define/xxx z #'6)
+ (list-pvars)])
+ (list-pvars)))
+ '((x w) (z y x w k x w) (x w)))
+
+ (check-equal? (let ()
+ (define/xxx w #'1)
+ (define/xxx x #'2)
+ (list (list-pvars)
+ (syntax-parse #'5
+ [k
+ (define/xxx w #'3)
+ (define/xxx x #'4)
+ (define/xxx y #'5)
+ (define/xxx z #'6)
+ (list (list-pvars)
+ (syntax-parse #'5
+ [k
+ (define/xxx x #'4)
+ (define/xxx y #'4)
+ (list-pvars)])
+ (list-pvars))])
+ (list-pvars)))
+ '((x w)
+ ((z y x w k x w)
+ (y x k z y x w k x w)
+ (z y x w k x w))
+ (x w)))))
+(gen-test-define define/syntax-parse)
+(gen-test-define define/with-syntax)
+\ No newline at end of file
