incremental output for #108

This commit is contained in:
Spencer Florence 2015-10-30 11:14:36 -04:00
parent 2c1cc1298e
commit 6c2ee429e9
3 changed files with 14 additions and 6 deletions

View File

@ -70,7 +70,9 @@ 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)] . files) (define (test-files! #:submod [submod-name 'test] #:env [env (current-cover-environment)]
#:dont-compile [dont-compile null]
. files)
(parameterize ([current-cover-environment env]) (parameterize ([current-cover-environment env])
(define abs (define abs
(for/list ([p (in-list files)]) (for/list ([p (in-list files)])
@ -82,15 +84,18 @@ Thus, In essence this module has three responsibilites:
(match p (match p
[(cons p _) p] [(cons p _) p]
[_ p]))) [_ p])))
(define excludes (map ->absolute dont-compile))
(define cover-load/use-compiled (make-cover-load/use-compiled abs-names)) (define cover-load/use-compiled (make-cover-load/use-compiled abs-names))
(define tests-failed (define tests-failed
(parameterize* ([current-load/use-compiled cover-load/use-compiled] (parameterize* ([current-load/use-compiled cover-load/use-compiled]
[current-namespace (get-namespace)]) [current-namespace (get-namespace)])
(with-cover-loggers (with-cover-loggers
(for ([f (in-list abs-names)]) (for ([f (in-list abs-names)]
(vprintf "forcing compilation of ~a" f) #:unless (member f excludes))
(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)])
(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)))))
(vprintf "ran ~s\n" files) (vprintf "ran ~s\n" files)

View File

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

View File

@ -94,8 +94,10 @@
(define generate-coverage (define generate-coverage
(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))))
(printf "generating test coverage for ~s\n" cleaned-files) (define passed (apply test-files!
(define passed (apply test-files! #:submod submod files)) #:submod submod
#:dont-compile exclude-paths
files))
(define coverage (get-test-coverage)) (define coverage (get-test-coverage))
(printf "dumping coverage info into ~s\n" coverage-dir) (printf "dumping coverage info into ~s\n" coverage-dir)
(parameterize ([irrelevant-submodules irrel-submods]) (parameterize ([irrelevant-submodules irrel-submods])