Allow multiple submodules to be run by specifying -s several times on the command-line.

This commit is contained in:
Georges Dupéron 2016-01-15 12:00:04 +01:00 committed by Spencer Florence
parent 1857f16a67
commit 7a5e12cd42
7 changed files with 31 additions and 11 deletions

View File

@ -70,7 +70,7 @@ Thus, In essence this module has three responsibilites:
;; Test files and build coverage map ;; Test files and build coverage map
;; returns true if no tests reported as failed, and no files errored. ;; returns true if no tests reported as failed, and no files errored.
(define (test-files! #:submod [submod-name 'test] #:env [env (current-cover-environment)] (define (test-files! #:submod [submod-names 'test] #:env [env (current-cover-environment)]
#:dont-compile [dont-compile null] #:dont-compile [dont-compile null]
. files) . files)
(parameterize ([current-cover-environment env]) (parameterize ([current-cover-environment env])
@ -94,7 +94,11 @@ Thus, In essence this module has three responsibilites:
#:unless (member f excludes)) #:unless (member f excludes))
(printf "cover: instrumenting: ~a\n" f) (printf "cover: instrumenting: ~a\n" f)
(compile-file f)) (compile-file f))
(for/fold ([tests-failed #f]) ([f (in-list abs)]) (for*/fold ([tests-failed #f])
([f (in-list abs)]
[submod-name (in-list (if (symbol? submod-names)
(list submod-names)
submod-names))])
(printf "cover: running file: ~a\n" f) (printf "cover: running file: ~a\n" f)
(define failed? (handle-file f submod-name)) (define failed? (handle-file f submod-name))
(or failed? tests-failed))))) (or failed? tests-failed)))))

View File

@ -10,7 +10,7 @@
(contract-out (contract-out
[coverage/c contract?] [coverage/c contract?]
[test-files! (->* () (#:submod symbol? [test-files! (->* () (#:submod (or/c symbol? (listof symbol?))
#:env environment? #:env environment?
#:dont-compile (listof path-string?)) #:dont-compile (listof path-string?))
#:rest #:rest

View File

@ -24,7 +24,7 @@
(define output-format "html") (define output-format "html")
(define exclude-paths '()) (define exclude-paths '())
(define include-exts '()) (define include-exts '())
(define submod 'test) (define submods 'test)
(define expansion-type 'dir) (define expansion-type 'dir)
(define irrel-submods #f) (define irrel-submods #f)
(define verbose #f) (define verbose #f)
@ -53,8 +53,8 @@
"include these extensions in files to cover. Accepts regular expressions" "include these extensions in files to cover. Accepts regular expressions"
(set! include-exts (cons f include-exts))] (set! include-exts (cons f include-exts))]
[("-s" "--submodule") s [("-s" "--submodule") s
"Run the given submodule instead of the test submodule" "Run the given submodule instead of the test submodule."
(set! submod (string->symbol s))] (set! submods (cons (string->symbol s) (if (symbol? submods) '() submods)))]
[("-e" "--irrelevant-submodules") s [("-e" "--irrelevant-submodules") s
"Consider the given submodules irrelevant when generating coverage. If not provided defaults to all submodules." "Consider the given submodules irrelevant when generating coverage. If not provided defaults to all submodules."
(unless irrel-submods (unless irrel-submods
@ -95,7 +95,7 @@
(hash-ref (get-formats) output-format (hash-ref (get-formats) output-format
(lambda _ (error 'cover "given unknown coverage output format: ~s" output-format)))) (lambda _ (error 'cover "given unknown coverage output format: ~s" output-format))))
(define passed (apply test-files! (define passed (apply test-files!
#:submod submod #:submod submods
#:dont-compile exclude-paths #:dont-compile exclude-paths
files)) files))
(define coverage (get-test-coverage)) (define coverage (get-test-coverage))

View File

@ -25,14 +25,14 @@ reading it. Typically this is the @racket[string?] for of the absolute path of t
The character locations are @racket[1] indexed. The character locations are @racket[1] indexed.
@defproc[(test-files! (#:submod submod symbol? 'test) @defproc[(test-files! (#:submod submod (or/c symbol? (listof symbol?)) 'test)
(files (files
(or/c path-string? (or/c path-string?
(list/c path-string? (list/c path-string?
(vectorof string? #:immutable #t)))) ...) (vectorof string? #:immutable #t)))) ...)
any]{ any]{
Runs all given @racket[files] and their submodule @racket[submod] (if it exists), storing the Runs all given @racket[files] and each submodule @racket[submod] (if it exists), storing the
coverage information. If the path is paired with a vector then that vector is used as the coverage information. If the path is paired with a vector then that vector is used as the
@racket[current-command-line-arguments] when executing that file. This vector must be immutable and @racket[current-command-line-arguments] when executing that file. This vector must be immutable and
not wrapped by a @racket[chaperone?] or @racket[impersonator?], nor may its elements be wrapped in a not wrapped by a @racket[chaperone?] or @racket[impersonator?], nor may its elements be wrapped in a

View File

@ -29,8 +29,9 @@ The @exec{raco cover} command accepts the following flags:
used when expanding directories, searching for files to cover.} used when expanding directories, searching for files to cover.}
@item{@Flag{v} or @DFlag{verbose} @item{@Flag{v} or @DFlag{verbose}
--- enable verbose logging} --- enable verbose logging}
@item{@Flag{s} or @DFlag{submod} @item{@Flag{s} or @DFlag{submodule}
--- run the given submodule instead of the @racket[_test] submodule.} --- run the given submodule instead of the @racket[_test] submodule. Can be
included more than once.}
@item{@Flag{e} or @DFlag{irrelevant-submodules} @item{@Flag{e} or @DFlag{irrelevant-submodules}
--- Consider the given submodules irrelevant when generating coverage. If not --- Consider the given submodules irrelevant when generating coverage. If not
provided defaults to all submodules. Can be included more than once.} provided defaults to all submodules. Can be included more than once.}

View File

@ -0,0 +1,8 @@
#lang racket/base
(require "../main.rkt" racket/runtime-path)
(define-runtime-path multiple-modules.rkt "multiple-modules.rkt")
(parameterize ([current-cover-environment (make-cover-environment)])
(test-files! multiple-modules.rkt #:submod '(test))
(test-files! multiple-modules.rkt #:submod '(a))
(test-files! multiple-modules.rkt #:submod '(test a b)))

View File

@ -0,0 +1,7 @@
#lang racket
(module* test #f
1)
(module a racket
2)
(module b racket
3)