From f052bbb28be90236c6fea89ef659d1ce70412848 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 20 Jun 2006 03:48:56 +0000
Subject: [PATCH] fixed PR 8133

svn: r3420
---
 collects/drscheme/syncheck.ss            |  8 ++++--
 collects/tests/drscheme/syncheck-test.ss | 36 ++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 3 deletions(-)

diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss
index 7b9579edb1..3f72f6ca34 100644
--- a/collects/drscheme/syncheck.ss
+++ b/collects/drscheme/syncheck.ss
@@ -1879,7 +1879,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)
+        (syntax-case* stx (rename struct all-from all-from-except) symbolic-compare?
           [identifier
            (identifier? (syntax identifier))
            (list (syntax identifier))]
@@ -1898,9 +1898,9 @@ If the namespace does not, they are colored the unbound color.
            null]))
           
       
-       ;; trim-require-prefix : syntax -> syntax
+      ;; trim-require-prefix : syntax -> syntax
       (define (trim-require-prefix require-spec)
-        (syntax-case require-spec (prefix all-except rename only)
+        (syntax-case* require-spec (prefix all-except rename only) symbolic-compare?
           [(prefix identifier module-name) 
            (syntax module-name)]
           [(all-except module-name identifer ...)
@@ -1911,6 +1911,8 @@ If the namespace does not, they are colored the unbound color.
            (syntax module-name)]
           [_ require-spec]))
       
+      (define (symbolic-compare? x y) (eq? (syntax-e x) (syntax-e y)))
+      
       ;; add-binders : syntax id-set -> void
       ;; transforms an argument list into a bunch of symbols/symbols
       ;; and puts them into the id-set
diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss
index 7404f57b71..67803fc7e7 100644
--- a/collects/tests/drscheme/syncheck-test.ss
+++ b/collects/tests/drscheme/syncheck-test.ss
@@ -28,6 +28,42 @@
   (define tests
     (list 
 
+     ;; the next two tests are new, complex ones that need to
+     ;; move to the bottom of the test file, when the rest of these
+     ;; tests are cleaned up.
+     ;; right now, there is a bug that causes lots of tests to fail for a stupid reason
+     
+     (build-test "(module m mzscheme (define-syntax rename #f) (require (rename mzscheme ++ +)))"
+                 '(("("                         default-color)
+                   ("module"                    imported-identifier)
+                   (" m mzscheme ("             default-color)
+                   ("define-syntax"             imported-identifier)
+                   (" "                         default-color)
+                   ("rename"                    lexically-bound-identifier)
+                   (" #f) ("                    default-color)
+                   ("require"                   imported-identifier)
+                   (" (rename mzscheme ++ +)))" default-color))
+
+                 (list '((10 18) (20 33) (46 53))
+                       '((54 76) (20 33) (46 53))))
+     
+     (build-test "(module m mzscheme (define-syntax rename #f) (define f 1) (provide (rename f g)))"
+                 '(("("               default-color)
+                   ("module"          imported-identifier)
+                   (" m mzscheme ("   default-color)
+                   ("define-syntax"   imported-identifier)
+                   (" "               default-color)
+                   ("rename"          lexically-bound-identifier)
+                   (" #f) ("          default-color)
+                   ("define"          imported-identifier)
+                   (" "               default-color)
+                   ("f"               lexically-bound-identifier)
+                   (" 1) ("           default-color)
+                   ("provide"         imported-identifier)
+                   (" (rename f g)))" default-color))
+                 (list '((10 18) (20 33) (46 52) (59 66))
+                       '((53 54) (75 76))))
+     
      (build-test "12345"
                 '(("12345" constant)))
      (build-test "'abcdef"