From 2be06881d033448b5d7c4d6ee5b6ae6140feb5c1 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 18 Jan 2008 02:44:45 +0000
Subject: [PATCH] fixed a bug in check syntax

svn: r8359
---
 collects/drscheme/syncheck.ss            | 10 +++---
 collects/tests/drscheme/syncheck-test.ss | 46 ++++++++++++++++++++++--
 2 files changed, 50 insertions(+), 6 deletions(-)

diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss
index cb1d30913d..1153a430a8 100644
--- a/collects/drscheme/syncheck.ss
+++ b/collects/drscheme/syncheck.ss
@@ -1524,9 +1524,10 @@ If the namespace does not, they are colored the unbound color.
                  
                  ;; tops are used here because a binding free use of a set!'d variable
                  ;; is treated just the same as (#%top . x).
-                 (if (identifier-binding (syntax var))
-                     (add-id varrefs (syntax var))
-                     (add-id tops (syntax var)))
+                 (when (syntax-original? (syntax var))
+                   (if (identifier-binding (syntax var))
+                       (add-id varrefs (syntax var))
+                       (add-id tops (syntax var))))
                  
                  (loop (syntax e)))]
               [(quote datum)
@@ -1632,7 +1633,8 @@ If the namespace does not, they are colored the unbound color.
                  (for-each (λ (provided-vars)
                              (for-each
                               (λ (provided-var)
-                                (add-id varrefs provided-var))
+                                (when (syntax-original? provided-var)
+                                  (add-id varrefs provided-var)))
                               provided-vars))
                            provided-varss))]
               
diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss
index 5ad0f84676..ff73f96d62 100644
--- a/collects/tests/drscheme/syncheck-test.ss
+++ b/collects/tests/drscheme/syncheck-test.ss
@@ -769,8 +769,50 @@
                   '((71 79) (95 96))
                   '((10 18) (20 38) (50 70) (82 94) (95 96))
                   '((39 47) (95 96))))
-
-
+     
+     ;; test case from Chongkai
+     (build-test (format "~s\n\n#reader'reader\n1\n"
+                         '(module reader mzscheme
+                            (provide (rename mrs read-syntax) read)
+                            (define (mrs sv p)
+                              (datum->syntax-object
+                               (read-syntax #f (open-input-string "a"))
+                               `(module f mzscheme
+                                  (provide x)
+                                  (define x 1))
+                               (list sv #f #f #f #f)))))
+                 '(("(" default-color)
+                   ("module" imported)
+                   (" reader mzscheme (" default-color)
+                   ("provide" imported)
+                   (" (rename " default-color)
+                   ("mrs" lexically-bound)
+                   (" read-syntax) " default-color)
+                   ("read" imported)
+                   (") (" default-color)
+                   ("define" imported)
+                   (" (" default-color)
+                   ("mrs" lexically-bound)
+                   (" " default-color)
+                   ("sv" lexically-bound)
+                   (" " default-color)
+                   ("p" lexically-bound)
+                   (") (" default-color)
+                   ("datum->syntax-object" imported)
+                   (" (" default-color)
+                   ("read-syntax" imported)
+                   (" #f (" default-color)
+                   ("open-input-string" imported)
+                   (" \"a\")) (" default-color)
+                   ("quasiquote" imported)
+                   (" (module f mzscheme (provide x) (define x 1))) (" default-color)
+                   ("list" imported)
+                   (" " default-color)
+                   ("sv" lexically-bound)
+                   (" #f #f #f #f))))\n\n#reader'reader\n1\n" default-color))
+                 
+                 (list '((77 79) (210 212))
+                       '((73 76) (41 44))))
      
      (make-dir-test "(module m mzscheme (require \"~a/list.ss\") foldl foldl)"
                     '(("("             default-color)