From c8aa5fdd82bf6b7e78d95a0e344ace10fb5bd23c Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 8 Oct 2007 13:53:30 +0000
Subject: [PATCH] fixed PR 8972

svn: r7451
---
 collects/drscheme/syncheck.ss            |  6 ++++--
 collects/tests/drscheme/syncheck-test.ss | 16 ++++++++++++++++
 2 files changed, 20 insertions(+), 2 deletions(-)

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)