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)))) (->absolute p))))
(define abs-paths (map (lambda (p) (if (list? p) (first p) p)) abs)) (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)] (parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-paths)]
[current-output-port [current-output-port
(if (verbose) (current-output-port) (open-output-nowhere))]) (if (verbose) (current-output-port) (open-output-nowhere))])
(define tests-failed #f) (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)) (define submod `(submod ,file ,submod-name))
(run-mod (if (module-declared? submod #t) submod file))))) (run-mod (if (module-declared? submod #t) submod file)))))
(vprintf "ran ~s\n" paths) (vprintf "ran ~s\n" paths)
(remove-unneeded-results abs-paths) (remove-unneeded-results! abs-paths)
(not tests-failed))) (not tests-failed)))
;; ModulePath -> Void ;; 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?))) (compile to-compile immediate-eval?)))
cover-compile) 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)) (define c (get-raw-coverage))
(for ([s (in-list (hash-keys c))] (for ([s (in-list (hash-keys c))]
#:when (not (member (srcloc-source s) paths))) #:when (not (member (srcloc-source s) paths)))

15
private/file-utils.rkt
View File

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

65
private/html.rkt
View File

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

25
raco.rkt
View File

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

2
tests/main.rkt
View File

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