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

test all the things

Browse Source
This commit is contained in:
Spencer Florence 2015-01-25 10:10:02 -05:00
parent eac3e05527
commit c85b91cb9a
5 changed files with 75 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
cover.rkt
View File

@ -40,7 +40,6 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(->absolute p))))
(define abs-paths (map (lambda (p) (if (list? p) (first p) p)) abs))
(parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-paths)]
[current-output-port
(if (verbose) (current-output-port) (open-output-nowhere))])
(define tests-failed #f)
@ -70,7 +69,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(define submod `(submod ,file ,submod-name))
(run-mod (if (module-declared? submod #t) submod file)))))
(vprintf "ran ~s\n" paths)
(remove-unneeded-results abs-paths)
(remove-unneeded-results! abs-paths)
(not tests-failed)))
;; ModulePath -> Void
@ -130,7 +129,9 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(compile to-compile immediate-eval?)))
cover-compile)
(define (remove-unneeded-results paths)
;; [Listof PathString] -> Void
;; remove any files not in paths from the raw coverage
(define (remove-unneeded-results! paths)
(define c (get-raw-coverage))
(for ([s (in-list (hash-keys c))]
#:when (not (member (srcloc-source s) paths)))

15
private/file-utils.rkt
View File

@ -5,12 +5,13 @@
;; PathString -> Path
(define (->relative path)
(if (relative-path? path)
(build-path path)
(let-values ([(_ lst)
(split-at (explode-path path)
(length (explode-path (current-directory))))])
(apply build-path lst))))
(simplify-path
(if (relative-path? path)
(build-path path)
(let-values ([(_ lst)
(split-at (explode-path path)
(length (explode-path (current-directory))))])
(apply build-path lst)))))
(module+ test
(parameterize ([current-directory (build-path "/test")])
@ -21,7 +22,7 @@
(define (->absolute path)
(if (absolute-path? path)
(if (string? path) path (path->string path))
(path->string (simplify-path path))
(path->string (simplify-path (build-path (current-directory) path)))))
(module+ test
(parameterize ([current-directory (build-path "/")])

65
private/html.rkt
View File

@ -18,10 +18,10 @@
(module+ test
(require rackunit "../cover.rkt" racket/runtime-path racket/set)
(require rackunit "../cover.rkt" racket/runtime-path racket/set "file-utils.rkt")
(define-runtime-path root "..")
(define-runtime-path tests/basic/prog.rkt "../tests/basic/prog.rkt")
(define (mock-covered? pos)
(define (mock-covered? pos)
(cond [(<= 1 pos 6) 'covered]
[(= 6 pos) 'missing]
[else 'uncovered])))
@ -32,6 +32,15 @@
(define fs (get-files coverage dir))
(write-files fs)
(move-support-files! dir))
(module+ test
(after
(parameterize ([current-directory root] [verbose #t])
(define temp-dir (make-temporary-file "covertmp~a" 'directory))
(test-files! tests/basic/prog.rkt)
(define coverage (get-test-coverage))
(generate-html-coverage coverage temp-dir)
(check-true (file-exists? (build-path temp-dir "tests/basic/prog.html"))))
(clear-coverage!)))
(define (get-files coverage dir)
(define file-list
@ -79,6 +88,7 @@
"coverage/tests/basic"))
(clear-coverage!)))))
;; (Listof (list file-path directory-path xexpr)) -> Void
(define (write-files f)
(for ([l (in-list f)])
(match-define (list f d e) l)
@ -87,10 +97,29 @@
(with-output-to-file f
#:exists 'replace
(thunk (write-xexpr e)))))
(module+ test
(test-begin
(define temp-dir (make-temporary-file "covertmp~a" 'directory))
(define xexpr '(body ()))
(define dir (build-path temp-dir "x"))
(define file (build-path dir "y.html"))
(write-files (list (list file dir xexpr)))
(check-equal? (file->string file)
"<body></body>")))
(define-runtime-path css "main.css")
(define (move-support-files! dir)
(copy-file css (build-path dir "main.css") #t))
(module+ test
(test-begin
(define temp-dir (make-temporary-file "covertmp~a" 'directory))
(define dir (build-path temp-dir "x"))
(define final-path (build-path dir "main.css"))
(make-directory* dir)
(move-support-files! dir)
(check-equal? (file->string final-path)
(file->string css))))
;; FileCoverage PathString PathString -> Xexpr
(define (make-html-file coverage path path-to-css)
@ -139,7 +168,7 @@
(define cov (hash-ref (get-test-coverage) f))
(define covered? (make-covered? cov f))
(define lines (string-split (file->string f) "\n"))
(check-equal? (file->html f covered?)
(check-equal? (file->html f covered?)
`(div ()
,(div:line-numbers (length lines))
,(div:file-lines lines covered?)))
@ -151,19 +180,19 @@
;; Nat -> Xexpr
;; create a div with line numbers in it
(define (div:line-numbers line-count)
`(div ([class "line-numbers"])
`(div ([class "line-numbers"])
,@(for/list ([num (in-range 1 (add1 line-count))])
`(div () ,(number->string num)))))
(module+ test
(check-equal?
(check-equal?
(div:line-numbers 5)
`(div ([class "line-numbers"])
`(div ([class "line-numbers"])
,@(build-list 5 (λ (n) `(div () ,(number->string (add1 n))))))))
;; [List String] Covered? -> Xexpr
(define (div:file-lines file-lines covered?)
(define-values (line-divs _)
(define-values (line-divs _)
(for/fold ([lines '()] [pos 1]) ([line (in-list file-lines)])
(values (cons (div:file-line line pos covered?) lines)
(add1 (+ pos (string-length line))))))
@ -180,22 +209,22 @@
;; Build a single line into an Xexpr
(define (div:file-line line pos covered?)
(cond [(zero? (string-length line)) '(br ())]
[else
[else
(define (build-span str type) `(span ([class ,(symbol->string type)]) ,str))
(define (add-expr cover-type expr cover-exprs)
(if cover-type
(if cover-type
(cons (build-span expr cover-type) cover-exprs)
cover-exprs))
(define-values (xexpr acc/str coverage-type)
(for/fold ([covered-exp '()] [expr/acc ""] [current-cover-type #f])
([c (in-string line)] [offset (in-naturals)])
(cond [(equal? c #\space)
(cond [(equal? c #\space)
(define new-expr (cons 'nbsp (add-expr current-cover-type expr/acc covered-exp)))
(values new-expr "" #f)]
[(equal? current-cover-type (covered? (+ pos offset)))
(values covered-exp (string-append expr/acc (string c)) current-cover-type)]
[else
[else
(define new-expr (add-expr current-cover-type expr/acc covered-exp))
(values new-expr (string c) (covered? (+ pos offset)))])))
`(div ([class "line"]) ,@(reverse (add-expr coverage-type acc/str xexpr)))]))
@ -231,7 +260,7 @@
(~r total-coverage-percentage #:precision 2)
"%")))
(module+ test
(module+ test
(test-begin (check-equal? (div:total-coverage (hash "foo.rkt" (list 0 10)
"bar.rkt" (list 10 10)))
'(div ([class "total-coverage"]) "Total Project Coverage: 50%"))))
@ -253,7 +282,7 @@
;; create a div that holds a link to the file report and expression
;; coverage information
(define (tr:file-report path expr-coverage-info stripe?)
(define local-file
(define local-file
(path->string (find-relative-path (current-directory) (string->path path))))
(define percentage (* 100 (/ (first expr-coverage-info) (second expr-coverage-info))))
(define styles `([class ,(string-append "file-info" (if stripe? " stripe" ""))]))
@ -262,7 +291,7 @@
(td () ,(~r percentage #:precision 2))
(td () ,(~r (first expr-coverage-info) #:precision 2))
(td () ,(~r (second expr-coverage-info) #:precision 2))))
(module+ test
(test-begin (check-equal? (tr:file-report "foo.rkt" (list 0 1) #f)
'(tr ((class "file-info"))
@ -301,8 +330,8 @@
(* (/ total-covered total-exprs) 100))
(module+ test
(test-begin
(check-equal?
(test-begin
(check-equal?
(expression-coverage-percentage/all (hash "foo.rkt" (list 0 10)
"bar.rkt" (list 10 10)))
50)))
@ -321,7 +350,7 @@
(values file (expression-coverage/file file (make-covered? data file)))))
;; FilePath Covered? -> ExpressionInfo
;; Takes a file path and a Covered? and
;; Takes a file path and a Covered? and
;; gets the number of expressions covered and the total number of expressions.
(define (expression-coverage/file path covered?)
(define (is-covered? e)

25
raco.rkt
View File

@ -102,19 +102,24 @@
(define-runtime-path root ".")
(define-runtime-path private "private")
(define-runtime-path main.rkt "main.rkt")
(parameterize ([current-directory root])
(define out
(set "main.rkt"
"private/coveralls.rkt"
"private/contracts.rkt"
"private/html.rkt"
"private/format-utils.rkt"
"private/file-utils.rkt"
"private/shared.rkt"
"private/raw.rkt"))
(define (do-test ->)
(parameterize ([current-directory root])
(check-equal? (list->set
(map (compose path->string ->relative)
(expand-directories (list (path->string main.rkt)
(->relative (path->string private))))))
(set "main.rkt"
"private/coveralls.rkt"
"private/contracts.rkt"
"private/html.rkt"
"private/format-utils.rkt"
"private/file-utils.rkt"
"private/shared.rkt"
"private/raw.rkt"))))
(->(path->string private))))))
out)))
(do-test ->relative)
(do-test ->absolute))
;; -> (HorribyNestedListsOf (or PathString (list path-string vector))
(define (expand-directory exts [omit-paths null] [args null])

2
tests/main.rkt
View File

@ -73,7 +73,7 @@
(after
(test-files! (->absolute prog.rkt))
(define abs (get-test-coverage))
(test-files! (->relative prog.rkt))
(test-files! (build-path (->relative prog.rkt)))
(define rel (get-test-coverage))
(check-equal? abs rel)
(clear-coverage!))))