diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss index 96369677c5..6454431ecd 100644 --- a/collects/drscheme/syncheck.ss +++ b/collects/drscheme/syncheck.ss @@ -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])) diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss index 1f95c27d70..5ad0f84676 100644 --- a/collects/tests/drscheme/syncheck-test.ss +++ b/collects/tests/drscheme/syncheck-test.ss @@ -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)