suzanne.soy/cover
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

now excluding info.rkt and fixed some awful names

Browse Source
This commit is contained in:
Ryan Plessner 2015-01-07 09:42:03 -05:00
parent 44f08e6bbd
commit a9c45182ab
1 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
raco.rkt
View File

@ -7,7 +7,7 @@
(define coverage-dir "coverage") (define coverage-dir "coverage")
(define output-format "html") (define output-format "html")
(define exclude-dirs '()) (define exclude-paths '("info.rkt"))
(define include-exts '()) (define include-exts '())
(define args (define args
@ -25,8 +25,8 @@
(verbose #t)] (verbose #t)]
#:multi #:multi
[("-e" "--exclude-from-output") t [("-e" "--exclude-from-output") t
"exclude all directories named this from the coverage report. By default excludes dirs named tests" "exclude all paths named this from the coverage report. By default excludes paths named tests"
(set! exclude-dirs (cons t exclude-dirs))] (set! exclude-paths (cons t exclude-paths))]
[("-i" "--include-extentions") f [("-i" "--include-extentions") f
"include these extentions in files to cover." "include these extentions in files to cover."
(set! include-exts (cons f include-exts))] (set! include-exts (cons f include-exts))]
@ -41,7 +41,7 @@
[else (error 'cover "given unknown coverage output format: ~s" output-format)])) [else (error 'cover "given unknown coverage output format: ~s" output-format)]))
(printf "generating test coverage for ~s\n" files) (printf "generating test coverage for ~s\n" files)
(define passed (apply test-files! files)) (define passed (apply test-files! files))
(define coverage (remove-dirs (get-test-coverage) exclude-dirs)) (define coverage (remove-excluded-paths (get-test-coverage) exclude-paths))
(printf "dumping coverage info into ~s\n" coverage-dir) (printf "dumping coverage info into ~s\n" coverage-dir)
(generate-coverage coverage coverage-dir) (generate-coverage coverage coverage-dir)
(exit (exit
@ -81,29 +81,32 @@
"not-run.rkt")))) "not-run.rkt"))))
;; Coverage -> Coverage ;; Coverage -> Coverage
(define (remove-dirs cover dirs) (define (remove-excluded-paths cover paths)
(for/hash ([(k v) cover] (for/hash ([(k v) cover]
#:unless (is-dir? k dirs)) #:unless (is-excluded-path? k paths))
(values k v))) (values k v)))
(module+ test (module+ test
(parameterize ([current-directory (build-path "/tests")]) (parameterize ([current-directory (build-path "/tests")])
(check-equal? (remove-dirs (hash "/tests/tests/x.rkt" null (check-equal? (remove-excluded-paths
"/tests/x/tests/x/x.rkt" null (hash "/tests/tests/x.rkt" null
"/tests/x.rkt" null) "/tests/x/tests/x/x.rkt" null
'("tests")) "/tests/x.rkt" null)
'("tests"))
(hash "/tests/x.rkt" null)))) (hash "/tests/x.rkt" null))))
;; PathString -> any/c ;; PathString [ListOf PathString]-> any/c
(define (is-dir? k dirs) (define (is-excluded-path? k paths)
(define expl (explode-path (->relative k))) (define expl (explode-path (->relative k)))
(ormap (lambda (d) (member (build-path d) expl)) (ormap (lambda (d) (member (build-path d) expl))
dirs)) paths))
(module+ test (module+ test
(parameterize ([current-directory (build-path "/tests")]) (parameterize ([current-directory (build-path "/tests")])
(check-not-false (is-dir? "/test/test/x.rkt" '("test"))) (check-not-false (is-excluded-path? "/test/test/x.rkt" '("test")))
(check-false (is-dir? "/test/x.rkt" '("test"))) (check-false (is-excluded-path? "/test/x.rkt" '("test")))
(check-false (is-dir? "/test/t/x.rkt" '("test"))))) (check-false (is-excluded-path? "/test/t/x.rkt" '("test")))))
;; PathString -> Path ;; PathString -> Path
(define (->relative path) (define (->relative path)
@ -113,6 +116,7 @@
(split-at (explode-path path) (split-at (explode-path path)
(length (explode-path (current-directory))))]) (length (explode-path (current-directory))))])
(apply build-path lst)))) (apply build-path lst))))
(module+ test (module+ test
(parameterize ([current-directory (build-path "/test")]) (parameterize ([current-directory (build-path "/test")])
(check-equal? (->relative "a") (check-equal? (->relative "a")