fixed PR 8972

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

View File

@ -2082,7 +2082,7 @@ If the namespace does not, they are colored the unbound color.
;; extract-provided-vars : syntax -> (listof syntax[identifier])
(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? (syntax identifier))
(list (syntax identifier))]
@ -2095,8 +2095,10 @@ If the namespace does not, they are colored the unbound color.
null]
[(all-from module-name) null]
[(all-from-except module-name identifer ...)
[(all-from-except module-name identifier ...)
null]
[(all-defined-except identifier ...)
(syntax->list #'(identifier ...))]
[_
null]))

View File

@ -739,6 +739,22 @@
(list '((10 18) (20 33) (46 52) (59 66))
'((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 +))"
'(("(" default-color)
("module" imported)