fixed a bug in check syntax

svn: r8359
This commit is contained in:
Robby Findler 2008-01-18 02:44:45 +00:00
parent 6ddbc52808
commit 2be06881d0
2 changed files with 50 additions and 6 deletions

View File

@ -1524,9 +1524,10 @@ If the namespace does not, they are colored the unbound color.
;; tops are used here because a binding free use of a set!'d variable
;; is treated just the same as (#%top . x).
(if (identifier-binding (syntax var))
(add-id varrefs (syntax var))
(add-id tops (syntax var)))
(when (syntax-original? (syntax var))
(if (identifier-binding (syntax var))
(add-id varrefs (syntax var))
(add-id tops (syntax var))))
(loop (syntax e)))]
[(quote datum)
@ -1632,7 +1633,8 @@ If the namespace does not, they are colored the unbound color.
(for-each (λ (provided-vars)
(for-each
(λ (provided-var)
(add-id varrefs provided-var))
(when (syntax-original? provided-var)
(add-id varrefs provided-var)))
provided-vars))
provided-varss))]

View File

@ -769,8 +769,50 @@
'((71 79) (95 96))
'((10 18) (20 38) (50 70) (82 94) (95 96))
'((39 47) (95 96))))
;; test case from Chongkai
(build-test (format "~s\n\n#reader'reader\n1\n"
'(module reader mzscheme
(provide (rename mrs read-syntax) read)
(define (mrs sv p)
(datum->syntax-object
(read-syntax #f (open-input-string "a"))
`(module f mzscheme
(provide x)
(define x 1))
(list sv #f #f #f #f)))))
'(("(" default-color)
("module" imported)
(" reader mzscheme (" default-color)
("provide" imported)
(" (rename " default-color)
("mrs" lexically-bound)
(" read-syntax) " default-color)
("read" imported)
(") (" default-color)
("define" imported)
(" (" default-color)
("mrs" lexically-bound)
(" " default-color)
("sv" lexically-bound)
(" " default-color)
("p" lexically-bound)
(") (" default-color)
("datum->syntax-object" imported)
(" (" default-color)
("read-syntax" imported)
(" #f (" default-color)
("open-input-string" imported)
(" \"a\")) (" default-color)
("quasiquote" imported)
(" (module f mzscheme (provide x) (define x 1))) (" default-color)
("list" imported)
(" " default-color)
("sv" lexically-bound)
(" #f #f #f #f))))\n\n#reader'reader\n1\n" default-color))
(list '((77 79) (210 212))
'((73 76) (41 44))))
(make-dir-test "(module m mzscheme (require \"~a/list.ss\") foldl foldl)"
'(("(" default-color)