From d277160879f3007f276b589edbac83d76cf5b208 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 13 Jul 2005 15:57:22 +0000
Subject: [PATCH] fixed bug in syntax checker; now works with only require spec

svn: r376
---
 collects/drscheme/syncheck.ss            | 22 ++++++++++++----------
 collects/tests/drscheme/syncheck-test.ss | 18 ++++++++++++++++--
 2 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss
index 0f0989019d..130a6a2179 100644
--- a/collects/drscheme/syncheck.ss
+++ b/collects/drscheme/syncheck.ss
@@ -49,7 +49,6 @@ If the namespace does not, they are colored the unbound color.
     syncheck:add-mouse-over-status
     syncheck:add-jump-to-definition
     syncheck:sort-bindings-table
-    syncheck:get-bindings-table
     syncheck:jump-to-next-bound-occurrence
     syncheck:jump-to-binding-occurrence
     syncheck:jump-to-definition
@@ -57,7 +56,8 @@ If the namespace does not, they are colored the unbound color.
     syncheck:clear-highlighting
     syncheck:button-callback
     syncheck:add-to-cleanup-texts
-    syncheck:error-report-visible?
+    ;syncheck:error-report-visible? ;; test suite uses this one.
+    ;syncheck:get-bindings-table    ;; test suite uses this one.
     syncheck:clear-error-message
     
     hide-error-report
@@ -1855,14 +1855,16 @@ If the namespace does not, they are colored the unbound color.
       
        ;; trim-require-prefix : syntax -> syntax
       (define (trim-require-prefix require-spec)
-        (let loop ([stx require-spec])
-          (syntax-case stx (prefix all-except rename)
-            [(prefix identifier module-name) (loop (syntax module-name))]
-            [(all-except module-name identifer ...)
-             (loop (syntax module-name))]
-            [(rename module-name local-identifer exported-identifer)
-             (loop (syntax module-name))]
-            [_ stx])))
+        (syntax-case require-spec (prefix all-except rename only)
+          [(prefix identifier module-name) 
+           (syntax module-name)]
+          [(all-except module-name identifer ...)
+           (syntax module-name)]
+          [(only module-name identifer ...)
+           (syntax module-name)]
+          [(rename module-name local-identifer exported-identifer)
+           (syntax module-name)]
+          [_ require-spec]))
       
       ;; add-binders : syntax id-set -> void
       ;; transforms an argument list into a bunch of symbols/symbols
diff --git a/collects/tests/drscheme/syncheck-test.ss b/collects/tests/drscheme/syncheck-test.ss
index e48287d33b..702c4f8165 100644
--- a/collects/tests/drscheme/syncheck-test.ss
+++ b/collects/tests/drscheme/syncheck-test.ss
@@ -27,7 +27,7 @@
   ;; tests : (listof test)
   (define tests
     (list 
-     
+
      (build-test "12345"
                 '(("12345" constant)))
      (build-test "'abcdef"
@@ -549,7 +549,21 @@
                 (list '((10 18) (20 27))
                       '((28 55) (73 80) (81 86))
                       '((56 71) (73 80) (81 86))))
-                      
+
+     (build-test "(module m mzscheme (require (only (lib \"list.ss\") foldr) (only (lib \"list.ss\") foldl)) foldl foldr)"
+                 '(("("                                                  default-color)
+                   ("module"                                             imported-syntax)
+                   (" m mzscheme ("                                      default-color)
+                   ("require"                                            imported-syntax)
+                   (" (only (lib \"list.ss\") foldr) (only (lib \"list.ss\") foldl)) " default-color)
+                   ("foldl"                                              imported-variable)
+                   (" "                                                  default-color)
+                   ("foldr"                                              imported-variable)
+                   (")"                                                  default-color))
+                 (list '((10 18) (20 27))
+                       '((28 56) (87 92) (93 98))
+                       '((57 85) (87 92) (93 98))))
+     
      (build-test "(module m mzscheme (require (lib \"etc.ss\")) (rec f 1))"
                 '(("("                     default-color)
                   ("module"                imported-syntax)