suzanne.soy/stxparse-info
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Bugfix and tests for define/with-syntax

Browse Source
This commit is contained in:
Georges Dupéron 2017-01-26 17:35:22 +01:00
parent ad27231d00
commit bff27464a9
3 changed files with 178 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
case/syntax.rkt
View File

@ -47,7 +47,7 @@
(define-syntax pvar (define-syntax pvar
(make-syntax-mapping 'depth (quote-syntax valvar))) (make-syntax-mapping 'depth (quote-syntax valvar)))
... ...
(define-pvars (pvar ...)))))])) (define-pvars pvar ...))))]))
;; Ryan: alternative name: define/syntax-pattern ?? ;; Ryan: alternative name: define/syntax-pattern ??
;; auxiliary macro ;; auxiliary macro

7
parse/experimental/private/substitute.rkt
View File

@ -60,13 +60,16 @@ An VarRef is one of
;; Used to indicate absent pvar in template; ?? catches ;; Used to indicate absent pvar in template; ?? catches
;; Note: not an exn, don't need continuation marks ;; Note: not an exn, don't need continuation marks
(require (only-in rackunit require/expose)) (require (only-in rackunit require/expose))
(require/expose syntax/parse/experimental/private/substitute #;(require/expose syntax/parse/experimental/private/substitute
(absent-pvar (absent-pvar
absent-pvar? absent-pvar?
absent-pvar-ctx absent-pvar-ctx
absent-pvar-v absent-pvar-v
absent-pvar-wanted-list?)) absent-pvar-wanted-list?))
#;(struct absent-pvar (ctx v 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?))
;; ============================================================ ;; ============================================================

125
test/test-current-pvars.rkt
View File

@ -1,5 +1,6 @@
#lang racket #lang racket
(require stxparse-info/parse (require stxparse-info/parse
stxparse-info/case
stxparse-info/current-pvars stxparse-info/current-pvars
racket/stxparam racket/stxparam
rackunit) rackunit)
@ -78,19 +79,47 @@
(syntax->datum (ref-nth-pvar 1)))]))]) (syntax->datum (ref-nth-pvar 1)))]))])
'(1 2 1))) '(1 2 1)))
;; tests for define/syntax-parse ;; Tests for syntax-case
(begin (begin
(check-equal? (list-pvars)
'())
(check-equal? (syntax-case #'(1 (2 3) a b c) ()
[(x (y ...) z ...)
(list-pvars)])
'(z y x))
(check-equal? (list-pvars)
'())
(check-equal? (syntax-parse #'1
[x
(syntax->datum (ref-nth-pvar 0))])
1)
(check-equal? (syntax-parse #'1
[x
(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)))
;; tests for define/syntax-parse and define/syntax-case
(define-syntax-rule (gen-test-define define/xxx)
(begin
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse z #'3) (define/xxx z #'3)
(list-pvars)]) (list-pvars)])
'(z y x)) '(z y x))
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse z #'3) (define/xxx z #'3)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)))]) (syntax->datum (ref-nth-pvar 2)))])
@ -99,14 +128,14 @@
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse x #'3) (define/xxx x #'3)
(list-pvars)]) (list-pvars)])
'(x y x)) '(x y x))
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse x #'3) (define/xxx x #'3)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)))]) (syntax->datum (ref-nth-pvar 2)))])
@ -115,8 +144,8 @@
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse x #'3) (define/xxx x #'3)
(define/syntax-parse y #'4) (define/xxx y #'4)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)) (syntax->datum (ref-nth-pvar 2))
@ -126,9 +155,9 @@
(check-equal? (syntax-parse #'1 (check-equal? (syntax-parse #'1
[x [x
#:with y #'2 #:with y #'2
(define/syntax-parse x #'3) (define/xxx x #'3)
(define/syntax-parse y #'4) (define/xxx y #'4)
(define/syntax-parse z #'5) (define/xxx z #'5)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)) (syntax->datum (ref-nth-pvar 2))
@ -138,8 +167,8 @@
(check-equal? (syntax-parse #'(1 2 3) (check-equal? (syntax-parse #'(1 2 3)
[(x y z) [(x y z)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(list (syntax->datum (ref-nth-pvar 0)) (list (syntax->datum (ref-nth-pvar 0))
(syntax->datum (ref-nth-pvar 1)) (syntax->datum (ref-nth-pvar 1))
(syntax->datum (ref-nth-pvar 2)) (syntax->datum (ref-nth-pvar 2))
@ -149,82 +178,82 @@
(check-equal? (syntax-parse #'(1 2 3) (check-equal? (syntax-parse #'(1 2 3)
[(x y z) [(x y z)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(list-pvars)]) (list-pvars)])
'(y x z y x)) '(y x z y x))
;; Test with nested let, less variables in the nested let ;; Test with nested let, less variables in the nested let
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(define/syntax-parse y #'3) (define/xxx y #'3)
(define/syntax-parse z #'4) (define/xxx z #'4)
(list (list-pvars) (list (list-pvars)
(let () (let ()
(define/syntax-parse w #'5) (define/xxx w #'5)
(define/syntax-parse x #'6) (define/xxx x #'6)
(list-pvars)) (list-pvars))
(list-pvars))) (list-pvars)))
'((z y x w) (x w z y x w) (z y x w))) '((z y x w) (x w z y x w) (z y x w)))
;; Test with nested let, more variables in the nested let ;; Test with nested let, more variables in the nested let
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(let () (let ()
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list-pvars)) (list-pvars))
(list-pvars))) (list-pvars)))
'((x w) (z y x w x w) (x w))) '((x w) (z y x w x w) (x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(define/syntax-parse y #'3) (define/xxx y #'3)
(define/syntax-parse z #'4) (define/xxx z #'4)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'5) (define/xxx w #'5)
(define/syntax-parse x #'6) (define/xxx x #'6)
(list-pvars)]) (list-pvars)])
(list-pvars))) (list-pvars)))
'((z y x w) (x w k z y x w) (z y x w))) '((z y x w) (x w k z y x w) (z y x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list-pvars)]) (list-pvars)])
(list-pvars))) (list-pvars)))
'((x w) (z y x w k x w) (x w))) '((x w) (z y x w k x w) (x w)))
(check-equal? (let () (check-equal? (let ()
(define/syntax-parse w #'1) (define/xxx w #'1)
(define/syntax-parse x #'2) (define/xxx x #'2)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse w #'3) (define/xxx w #'3)
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'5) (define/xxx y #'5)
(define/syntax-parse z #'6) (define/xxx z #'6)
(list (list-pvars) (list (list-pvars)
(syntax-parse #'5 (syntax-parse #'5
[k [k
(define/syntax-parse x #'4) (define/xxx x #'4)
(define/syntax-parse y #'4) (define/xxx y #'4)
(list-pvars)]) (list-pvars)])
(list-pvars))]) (list-pvars))])
(list-pvars))) (list-pvars)))
@ -232,4 +261,6 @@
((z y x w k x w) ((z y x w k x w)
(y x k z y x w k x w) (y x k z y x w k x w)
(z y x w k x w)) (z y x w k x w))
(x w)))) (x w)))))
(gen-test-define define/syntax-parse)
(gen-test-define define/with-syntax)