Issue 110

drracket-tool-lib/drracket/private/syncheck/traversals.rkt

@@ -801,18 +801,22 @@
       (unless (hash-ref module-lang-requires (list (syntax-source stx)
                                                    (syntax-position stx)
                                                    (syntax-span stx)) #f)
+        ;; Use module path portion of syntax: Its more-specific
+        ;; location matters for e.g. combine-in and things that expand
+        ;; to it. See issue #110.
+        (define mod-stx (phaseless-spec->raw-module-path stx))
         (define defs-text (current-annotations))
-        (define source-editor (find-source-editor stx))
+        (define source-editor (find-source-editor mod-stx))
         (when (and defs-text source-editor)
-          (define pos (syntax-position stx))
-          (define span (syntax-span stx))
+          (define pos (syntax-position mod-stx))
+          (define span (syntax-span mod-stx))
           (when (and pos span)
             (define start (- pos 1))
             (define fin (+ start span))
             (send defs-text syncheck:add-unused-require source-editor start fin)
             (send defs-text syncheck:add-text-type
                   source-editor start fin 'unused-identifier)))
-        (color stx unused-require-style-name)))))
+        (color mod-stx unused-require-style-name)))))
 
 ;; color-unused-binder : source integer integer -> void
 (define (color-unused-binder source start end)

drracket-tool-test/tests/check-syntax/syncheck-direct.rkt

@@ -484,4 +484,48 @@
       (expand
        '(let-syntax ([m (λ (_) #`(let ([x 1]) x))])
           (m))))
-     (done))))
+     (done))))
+
+;;; Issue #110
+(let ()
+  (define src (format "~s"
+                      '(module m racket/base
+                         (require racket/require
+                                  (multi-in racket (list match))
+                                  racket/set
+                                  (rename-in racket/list [first 1st]))
+                         first
+                         1st)))
+  ;; Check that change doesn't break arrows
+  (check-equal? (get-binding-arrows/pxpy src)
+                (set '((31 45 0.5 0.5) (47 55 0.5 0.5))
+                     '((10 21 0.5 0.5) (89 98 0.5 0.5))
+                     '((10 21 0.5 0.5) (23 30 0.5 0.5))
+                     '((64 68 0.5 0.5) (125 130 0.5 0.5))
+                     '((99 110 0.5 0.5) (131 134 0.5 0.5))))
+  ;; Check unused requires
+  (define collector%
+    (class (annotations-mixin object%)
+      (super-new)
+      (define unused-requires (set))
+      (define/override (syncheck:find-source-object stx) stx)
+      (define/override (syncheck:add-unused-require _ beg end)
+        (set! unused-requires
+              (set-add unused-requires
+                       (list beg end))))
+      (define/public (get-unused-requires) unused-requires)))
+  (define annotations (new collector%))
+  (parameterize ([current-annotations annotations]
+                 [current-namespace (make-base-namespace)])
+    (define-values (add-syntax done)
+      (make-traversal (current-namespace) #f))
+    (add-syntax (expand
+                 (read-syntax
+                   'the-source
+                   (open-input-string
+                    src))))
+    (done))
+  (check-equal? (send annotations get-unused-requires)
+                ;; Note: These positions are from (format "~s")
+                (set '(69 74)           ;racket/match from multi-in
+                     '(77 87))))        ;racket/set