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

Makes test work when compilation strips source locations

Browse Source
This commit is contained in:
Casey Klein 2011-08-16 19:17:50 -05:00
parent 52fb1e3460
commit cee4566ed4
1 changed files with 28 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/redex/tests/check-syntax-test.rkt
View File

@ -7,6 +7,19 @@
(reset-count) (reset-count)
(define-syntax (identifier stx)
(syntax-case stx ()
[(_ x)
(identifier? #'x)
#`(let ([p (open-input-string (format "~s" 'x))])
(port-count-lines! p)
(set-port-next-location!
p
#,(syntax-line #'x)
#,(syntax-column #'x)
#,(syntax-position #'x))
(read-syntax '#,(syntax-source #'x) p))]))
(define (source stx) (define (source stx)
(list (syntax-source stx) (list (syntax-source stx)
(syntax-line stx) (syntax-line stx)
@ -64,15 +77,15 @@
(define-values (add-syntax done) (define-values (add-syntax done)
(make-traversal module-namespace #f)) (make-traversal module-namespace #f))
(define language-def-name #'L) (define language-def-name (identifier L))
(define language-use-name #'L) (define language-use-name (identifier L))
(define mode-name #'J) (define mode-name (identifier J))
(define contract-name #'J) (define contract-name (identifier J))
(define conclusion-name #'J) (define conclusion-name (identifier J))
(define premise-name #'J) (define premise-name (identifier J))
(define render-name #'J) (define render-name (identifier J))
(define holds-name #'J) (define holds-name (identifier J))
(define language-binding (define language-binding
(list language-def-name language-use-name)) (list language-def-name language-use-name))
@ -106,14 +119,14 @@
(define-values (add-syntax done) (define-values (add-syntax done)
(make-traversal module-namespace #f)) (make-traversal module-namespace #f))
(define language-def-name #'L) (define language-def-name (identifier L))
(define language-use-name #'L) (define language-use-name (identifier L))
(define contract-name #'f) (define contract-name (identifier f))
(define lhs-name #'f) (define lhs-name (identifier f))
(define rhs-name #'f) (define rhs-name (identifier f))
(define render-name #'f) (define render-name (identifier f))
(define term-name #'f) (define term-name (identifier f))
(define language-binding (define language-binding
(list language-def-name language-use-name)) (list language-def-name language-use-name))