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

fixed PR 8972

Browse Source 
svn: r7451
This commit is contained in:
Robby Findler 2007-10-08 13:53:30 +00:00
parent 0d641835a9
commit c8aa5fdd82
2 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/drscheme/syncheck.ss
View File

@ -2082,7 +2082,7 @@ If the namespace does not, they are colored the unbound color.
;; extract-provided-vars : syntax -> (listof syntax[identifier]) ;; extract-provided-vars : syntax -> (listof syntax[identifier])
(define (extract-provided-vars stx) (define (extract-provided-vars stx)
(syntax-case* stx (rename struct all-from all-from-except) symbolic-compare? (syntax-case* stx (rename struct all-from all-from-except all-defined-except) symbolic-compare?
[identifier [identifier
(identifier? (syntax identifier)) (identifier? (syntax identifier))
(list (syntax identifier))] (list (syntax identifier))]
@ -2095,8 +2095,10 @@ If the namespace does not, they are colored the unbound color.
null] null]
[(all-from module-name) null] [(all-from module-name) null]
[(all-from-except module-name identifer ...) [(all-from-except module-name identifier ...)
null] null]
[(all-defined-except identifier ...)
(syntax->list #'(identifier ...))]
[_ [_
null])) null]))

16
collects/tests/drscheme/syncheck-test.ss
View File

@ -739,6 +739,22 @@
(list '((10 18) (20 33) (46 52) (59 66)) (list '((10 18) (20 33) (46 52) (59 66))
'((53 54) (75 76)))) '((53 54) (75 76))))
(build-test "(module m mzscheme (define X 1) (provide (all-defined-except X)))"
'(("(" default-color)
("module" imported)
(" m mzscheme (" default-color)
("define" imported)
(" " default-color)
("X" lexically-bound)
(" 1) (" default-color)
("provide" imported)
(" (all-defined-except " default-color)
("X" lexically-bound)
(")))" default-color))
(list '((10 18) (20 26) (33 40))
'((27 28) (61 62))))
(build-test "(module m mzscheme (require-for-syntax mzscheme) (require-for-template mzscheme) (quote-syntax +))" (build-test "(module m mzscheme (require-for-syntax mzscheme) (require-for-template mzscheme) (quote-syntax +))"
'(("(" default-color) '(("(" default-color)
("module" imported) ("module" imported)