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

make check syntax traverse (module* ...) expressions

Browse Source 
closes PR 13095
This commit is contained in:
Robby Findler 2012-09-19 06:42:35 -05:00
parent ae87169d7e
commit 21e0d9e031
2 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/drracket/private/syncheck/traversals.rkt
View File

@ -192,7 +192,8 @@
(syntax-case* stx-obj (#%plain-lambda case-lambda if begin begin0 let-values letrec-values set! (syntax-case* stx-obj (#%plain-lambda case-lambda if begin begin0 let-values letrec-values set!
quote quote-syntax with-continuation-mark quote quote-syntax with-continuation-mark
#%plain-app #%top #%plain-module-begin #%plain-app #%top #%plain-module-begin
define-values define-syntaxes begin-for-syntax module define-values define-syntaxes begin-for-syntax
module module*
#%require #%provide #%expression) #%require #%provide #%expression)
(λ (x y) (free-identifier=? x y level 0)) (λ (x y) (free-identifier=? x y level 0))
[(#%plain-lambda args bodies ...) [(#%plain-lambda args bodies ...)
@ -312,6 +313,7 @@
(begin (begin
(annotate-raw-keyword stx-obj varrefs) (annotate-raw-keyword stx-obj varrefs)
(for-each (lambda (e) (level-loop e (+ level 1))) (syntax->list (syntax (exp ...)))))] (for-each (lambda (e) (level-loop e (+ level 1))) (syntax->list (syntax (exp ...)))))]
[(module m-name lang (#%plain-module-begin bodies ...)) [(module m-name lang (#%plain-module-begin bodies ...))
(begin (begin
(annotate-raw-keyword stx-obj varrefs) (annotate-raw-keyword stx-obj varrefs)
@ -320,6 +322,17 @@
(hash-cons! requires (syntax->datum (syntax lang)) (syntax lang)) (hash-cons! requires (syntax->datum (syntax lang)) (syntax lang))
(for-each loop (syntax->list (syntax (bodies ...)))))] (for-each loop (syntax->list (syntax (bodies ...)))))]
[(module* m-name lang (#%plain-module-begin bodies ...))
(begin
(annotate-raw-keyword stx-obj varrefs)
(when (syntax-e #'lang)
(hash-set! module-lang-requires (syntax lang) #t)
((annotate-require-open user-namespace user-directory) (syntax lang))
(hash-cons! requires (syntax->datum (syntax lang)) (syntax lang)))
(for-each loop (syntax->list (syntax (bodies ...)))))]
; top level or module top level only: ; top level or module top level only:
[(#%require require-specs ...) [(#%require require-specs ...)

13
collects/tests/drracket/syncheck-test.rkt
View File

@ -50,7 +50,7 @@
;; tests : (listof test) ;; tests : (listof test)
(define tests (define tests
(list (list
(build-test "12345" (build-test "12345"
'(("12345" constant))) '(("12345" constant)))
(build-test "'abcdef" (build-test "'abcdef"
@ -989,6 +989,17 @@
'((61 63) (65 67)) '((61 63) (65 67))
'((6 12) (14 21) (40 43) (49 54) (74 80)))) '((6 12) (14 21) (40 43) (49 54) (74 80))))
(build-test "#lang racket/base\n(define red 1)\n(module+ test red)"
'(("#lang racket/base\n(" default-color)
("define" imported)
(" " default-color)
("red" lexically-bound)
(" 1)\n(module+ test " default-color)
("red" imported)
(")" default-color))
'(((26 29) (47 50))
((6 17) (19 25))))
(build-rename-test "(lambda (x) x)" (build-rename-test "(lambda (x) x)"
9 9
"x" "x"