laying groundwork for submodule ignoring

private/format-utils.rkt

@@ -6,6 +6,7 @@
          racket/match
          racket/port
          racket/set
+         racket/bool
          syntax-color/racket-lexer
          syntax/modread
          syntax/parse
@@ -25,19 +26,19 @@
 ;; A Covered? is a [Nat [#:byte? Boolean] -> Cover]
 
 ;; FileCoverage PathString -> Covered?
-(define (make-covered? c path)
+(define (make-covered? c path #:ignored-submods [submods #f])
   (define vec
     (list->vector (string->list (file->string path))))
   (define file/byte->str-offset (make-byte->str-offset vec))
   (define file-location-coverage-cache
-    (coverage-cache-file path c))
+    (coverage-cache-file path c submods))
   (lambda (loc #:byte? [byte? #f])
     (hash-ref file-location-coverage-cache (if (not byte?) loc (- loc (file/byte->str-offset loc)))
               'missing)))
 
 
 ;; Path FileCoverage OffsetFunc -> [Hashof Natural Cover]
-(define (coverage-cache-file f c)
+(define (coverage-cache-file f c submods)
   (vprintf "caching coverage info for ~s\n" f)
   (with-input-from-file f
     (thunk
@@ -47,7 +48,7 @@
          (if f
              (f 'color-lexer racket-lexer)
              racket-lexer)))
-     (define irrelevant? (make-irrelevant? lexer f))
+     (define irrelevant? (make-irrelevant? lexer f submods))
      (define file-length (string-length (file->string f)))
      (define cache
        (for/hash ([i (in-range 1 (add1 file-length))])
@@ -56,8 +57,7 @@
                        [else (raw-covered? i c)]))))
      cache)))
 
-;; TODO should we only ignore test (and main) submodules?
-(define (make-irrelevant? lexer f)
+(define (make-irrelevant? lexer f submods)
   (define s (mutable-set))
   (define-values (for-lex for-str) (replicate-file-port f (current-input-port)))
   (define str (apply vector (string->list (port->string for-str))))
@@ -85,8 +85,12 @@
     (syntax-parse stx
       #:datum-literals (module module* module+ begin-for-syntax)
       [((~or module module* module+ begin-for-syntax)
+        n:id
         e ...)
-       #:when (not first?)
+       #:when (and (not first?)
+                   (submods
+                    . implies .
+                    (member (syntax-e #'n) submods)))
        (define ?start (syntax-position stx))
        (when ?start
          (define start (- ?start (* 2 (offset/mod ?start))))