Merge pull request #38 from florence/submodule-testing-propigation

Submodule testing propagation (Fixes #15)

main.rkt

@@ -14,6 +14,7 @@
                     any)]
   [clear-coverage! (-> any)]
   [get-test-coverage (-> coverage/c)]
+  [irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))]
   [make-covered?
    (-> file-coverage/c path-string?
        (->* (exact-positive-integer?)

private/format-utils.rkt

@@ -1,11 +1,12 @@
 #lang racket/base
-(provide make-covered?)
+(provide make-covered? irrelevant-submodules)
 (require racket/file
          racket/function
          racket/list
          racket/match
          racket/port
          racket/set
+         racket/bool
          syntax-color/racket-lexer
          syntax/modread
          syntax/parse
@@ -24,20 +25,24 @@
 
 ;; A Covered? is a [Nat [#:byte? Boolean] -> Cover]
 
-;; FileCoverage PathString -> Covered?
+;; FileCoverage PathString #:ignored-submods (maybe (listof symbol)) -> Covered?
 (define (make-covered? c path)
+  (define submods (irrelevant-submodules))
   (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)))
 
+;; (or/c #f (listof symbol))
+(define irrelevant-submodules (make-parameter #f))
 
-;; Path FileCoverage OffsetFunc -> [Hashof Natural Cover]
-(define (coverage-cache-file f c)
+;; Path FileCoverage -> [Hashof Natural Cover]
+;; build a hash caching coverage info for that file
+(define (coverage-cache-file f c submods)
   (vprintf "caching coverage info for ~s\n" f)
   (with-input-from-file f
     (thunk
@@ -47,7 +52,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 +61,9 @@
                        [else (raw-covered? i c)]))))
      cache)))
 
-;; TODO should we only ignore test (and main) submodules?
-(define (make-irrelevant? lexer f)
+;; Lexer(in the sence of color:text<%>) InputPort (Maybe (Listof Symbol)) -> (Natural -> Boolean)
+;; builds a function that determines if a given location in that port is irrelivent.
+(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 +91,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))))
@@ -97,14 +107,17 @@
       [_else (void)]))
   (lambda (i) (set-member? s i)))
 
+;; Path FilePort -> FilePort FilePort
+;; creates two ports to that file at the same position at the first
 (define (replicate-file-port f p)
   (define f1 (open-input-file f))
   (define f2 (open-input-file f))
   (file-position f1 (file-position p))
   (file-position f2 (file-position p))
   (values f1 f2))
 
-
+;; Natural Coverage -> (U 'covered 'uncovered 'irrelevant)
+;; lookup i in c. irrelevant if its not contained
 (define (raw-covered? i c)
   (define loc i)
   (define-values (mode _)
@@ -122,6 +135,7 @@
     [(#f) 'uncovered]
     [else 'irrelevant]))
 
+;; String -> (Natural -> Natural)
 ;; used for determining character/byte offsets for a given
 ;; 1 indexed byte locaiton
 (define ((make-byte->str-offset str) offset)

raco.rkt

@@ -8,6 +8,7 @@
          (only-in "private/contracts.rkt" coverage-gen/c)
          "private/shared.rkt"
          "private/file-utils.rkt"
+         "private/format-utils.rkt"
          (only-in (submod compiler/commands/test paths) collection-paths)
          pkg/lib)
 
@@ -23,6 +24,7 @@
   (define include-exts '())
   (define submod 'test)
   (define expansion-type 'dir)
+  (define irrel-submods #f)
 
   (define args
      (command-line
@@ -50,6 +52,11 @@
       [("-s" "--submodule") s
        "Run the given submodule instead of the test submodule"
        (set! submod (string->symbol s))]
+      [("-e" "--irrelevant-submodules") s
+       "Concider the given submodules irrelevant when generating coverage. If not provided defaults to all submodules."
+       (unless irrel-submods
+         (set! irrel-submods null))
+       (set! irrel-submods (cons (string->symbol s) irrel-submods))]
       #:once-any
       [("-c" "--collection") "Interprets the arguments as collections whose content should be tested (in the same way as directory content)."
        (set! expansion-type 'collection)]
@@ -71,7 +78,8 @@
   (define passed (keyword-apply test-files! '(#:submod) (list submod) files))
   (define coverage (remove-excluded-paths (get-test-coverage) exclude-paths))
   (printf "dumping coverage info into ~s\n" coverage-dir)
-  (generate-coverage coverage coverage-dir)
+  (parameterize ([irrelevant-submodules irrel-submods])
+    (generate-coverage coverage coverage-dir))
   (unless passed
     (printf "some tests failed\n")))
 

scribblings/api.scrbl

@@ -46,18 +46,23 @@ coverage information for that file @racket[make-covered?] returns
 a functions that determines if some @racket[1] indexed character or byte location
 in that file is covered. By default it checks character locations.
 
-There are three possible results:
-@itemize[@item{@racket['irrelevant] --- The location is not considered relevant to coverage information.
-It is either not in the coverage information; is in a submodule; is a @racket[begin-for-syntax] form;
-or lexes (in the sense of that languages, @racket[_color-lexer]) as a comment or whitespace.}
-@item{@racket['covered] --- The location is not @racket['irrelevant] and is
-covered}
-@item{@racket['uncovered] --- The location is not @racket['uncovered]
-and is not covered}]
-                                   }
+There are three possible results: @itemize[@item{@racket['irrelevant] --- The location is not
+considered relevant to coverage information.  It is either not in the coverage information; is in a
+submodule specified by @racket[irrelevant-submodules]; is a @racket[begin-for-syntax] form; or lexes
+(in the sense of that languages, @racket[_color-lexer]) as a comment or whitespace.}
+@item{@racket['covered] --- The location is not @racket['irrelevant] and is covered}
+@item{@racket['uncovered] --- The location is not @racket['uncovered] and is not covered}] }
+
+@defthing[irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))]{
+
+A parameter that controls with submodules are considered irrelevant by @racket[make-covered?]. It
+defaults to @racket[#f], which tells @racket[make-covered?] to consider all submodules
+irrelevant. If its value is a list, then each element of that list is the name of a submodule to be
+considered irrelevant.}
 
 @deftogether[(@defproc[(generate-coveralls-coverage (c coverage/c) (p path-string? "coverage")) any]
               @defproc[(generate-html-coverage (c coverage/c) (p path-string? "coverage")) any])]{
-Generates coverage information in the coveralls and html
-formats. Equivalent to the specifications of the @Flag{c} argument to
-@exec{raco cover}.}
+
+Generates coverage information in the coveralls and html formats. Equivalent to the specifications
+of the @Flag{c} argument to @exec{raco cover}. Both use @racket[make-covered?] to determine file
+coverage.}

scribblings/basics.scrbl

@@ -38,6 +38,9 @@ The @exec{raco cover} command accepts the following flags:
                --- enable verbose logging}
          @item{@Flag{s} or @DFlag{submod}
                --- run the given submodule instead of the test submodule.}
+         @item{@Flag{e} or @DFlag{include-extensions}
+               --- Concider the given submodules irrelevant when generating coverage. If not
+               provided defaults to all submodules. Can be included more than once.}
          @item{@Flag{c} or @DFlag{collection}
                --- Interprets the arguments as collections whose content should be
                tested (in the same way as directory content).}

tests/main.rkt

@@ -3,7 +3,7 @@
 ;; for every .rkt file in those directories it loads
 ;; tests that file and checks its coverage against an
 ;; .rktl file of the same name
-(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage)
+(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules)
          "../private/file-utils.rkt"
          racket/runtime-path rackunit)
 
@@ -65,7 +65,10 @@
 
 (module+ test
   (define-runtime-path-list test-dirs '("basic" "simple-multi" "syntax"))
-  (for-each (compose test-dir path->string) test-dirs))
+  (for-each (compose test-dir path->string) test-dirs)
+  (define-runtime-path submods "submods")
+  (parameterize ([irrelevant-submodules null])
+    (test-dir (path->string submods))))
 
 (module+ test
   (define-runtime-path prog.rkt "prog.rkt")

tests/submods/prog.rkt

@@ -0,0 +1,2 @@
+#lang racket
+(module+ test (+ 1 2))

tests/submods/prog.rktl

@@ -0,0 +1,2 @@
+((1 35))
+()