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

added some tests

Browse Source
This commit is contained in:
Ryan Plessner 2015-01-22 21:16:54 -05:00
parent 7fa3ad7e1e
commit 00335ccc12
1 changed files with 56 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
private/html.rkt
View File

@ -20,7 +20,11 @@
(module+ test (module+ test
(require rackunit "../cover.rkt" racket/runtime-path racket/set) (require rackunit "../cover.rkt" racket/runtime-path racket/set)
(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)
(cond [(<= 1 pos 6) 'covered]
[(= 6 pos) 'missing]
[else 'uncovered])))
;;; Coverage [PathString] -> Void ;;; Coverage [PathString] -> Void
(define (generate-html-coverage coverage [d "coverage"]) (define (generate-html-coverage coverage [d "coverage"])
@ -55,7 +59,7 @@
(cons (list (build-path dir "index.html") dir index) (cons (list (build-path dir "index.html") dir index)
file-list)) file-list))
#;(module+ test (module+ test
(test-begin (test-begin
(parameterize ([current-directory root]) (parameterize ([current-directory root])
(after (after
@ -105,7 +109,7 @@
(define (%s->xexpr %) (define (%s->xexpr %)
`(p () ,(~a "expr" ': " " (~r (* 100 %) #:precision 2) "%") (br ()))) `(p () ,(~a "expr" ': " " (~r (* 100 %) #:precision 2) "%") (br ())))
#;(module+ test (module+ test
(test-begin (test-begin
(define f (path->string (simplify-path tests/basic/prog.rkt))) (define f (path->string (simplify-path tests/basic/prog.rkt)))
(test-files! f) (test-files! f)
@ -129,26 +133,18 @@
,(div:line-numbers (length lines)) ,(div:line-numbers (length lines))
,(div:file-lines lines covered?))) ,(div:file-lines lines covered?)))
#;(module+ test (module+ test
(define (test file out) (test-begin
(test-files! file)
(define cov (hash-ref (get-test-coverage) file))
(define covered? (make-covered? cov file))
(check-equal? (file->html file covered?)
out)
(clear-coverage!))
(define f (path->string (simplify-path tests/basic/prog.rkt))) (define f (path->string (simplify-path tests/basic/prog.rkt)))
(test f (test-files! f)
`(ol () (define cov (hash-ref (get-test-coverage) f))
(li () (define covered? (make-covered? cov f))
,@(for/list ([c (in-string (first (string-split (file->string f) "\n")))]) (define lines (string-split (file->string f) "\n"))
`(span ((class "covered")) (check-equal? (file->html f covered?)
,(encode-char c)))) `(div ()
,@(for/list ([l (rest (string-split (file->string f) "\n"))]) ,(div:line-numbers (length lines))
`(li () ,(div:file-lines lines covered?)))
,@(for/list ([c l]) (clear-coverage!)))
`(span ((class ,(if (equal? c #\space) "irrelevant" "covered")))
,(encode-char c))))))))
;; File Report ;; File Report
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -157,9 +153,15 @@
;; 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 line-count)]) ,@(for/list ([num (in-range 1 (add1 line-count))])
`(div () ,(number->string num))))) `(div () ,(number->string num)))))
(module+ test
(check-equal?
(div:line-numbers 5)
`(div ([class "line-numbers"])
,@(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 _)
@ -168,29 +170,34 @@
(add1 (+ pos (string-length line)))))) (add1 (+ pos (string-length line))))))
`(div ([class "file-lines"]) ,@(reverse line-divs))) `(div ([class "file-lines"]) ,@(reverse line-divs)))
(module+ test
(define lines '("hello world" "goodbye"))
(check-equal? (div:file-lines lines mock-covered?)
`(div ([class "file-lines"])
,(div:file-line (first lines) 1 mock-covered?)
,(div:file-line (second lines) 12 mock-covered?))))
;; String Nat Covered? -> Xexpr ;; String Nat Covered? -> Xexpr
;; 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)
(if cover-type
(cons (build-span expr cover-type) 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 (define new-expr (cons 'nbsp (add-expr current-cover-type expr/acc covered-exp)))
(cons 'nbsp
(if current-cover-type
(cons (build-span expr/acc current-cover-type) covered-exp)
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 (define new-expr (add-expr current-cover-type expr/acc covered-exp))
(if current-cover-type
(cons (build-span expr/acc current-cover-type) covered-exp)
covered-exp))
(values new-expr (string c) (covered? (+ pos offset)))]))) (values new-expr (string c) (covered? (+ pos offset)))])))
(define result (define result
(if coverage-type (if coverage-type
@ -199,10 +206,7 @@
`(div ([class "line"]) ,@(reverse result))])) `(div ([class "line"]) ,@(reverse result))]))
(module+ test (module+ test
(define mock-covered? (check-equal? (div:file-line "" 1 mock-covered?) '(br ()))
(λ (pos) (cond [(<= 1 pos 6) 'covered]
[(= 6 pos) 'missing]
[else 'uncovered])))
(check-equal? (div:file-line "hello world" 1 mock-covered?) (check-equal? (div:file-line "hello world" 1 mock-covered?)
'(div ([class "line"]) (span ([class "covered"]) "hello") '(div ([class "line"]) (span ([class "covered"]) "hello")
nbsp nbsp
@ -234,6 +238,11 @@
`(div ([class "total-coverage"]) `(div ([class "total-coverage"])
,(string-append "Total Project Coverage: " coverage-as-string "%"))) ,(string-append "Total Project Coverage: " coverage-as-string "%")))
(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.00%"))))
;; [Hash FilePath ExpressionInfo] -> Xexpr ;; [Hash FilePath ExpressionInfo] -> Xexpr
(define (table:file-reports expr-coverages) (define (table:file-reports expr-coverages)
`(table ([class "file-list"]) `(table ([class "file-list"])
@ -272,17 +281,24 @@
(td () "No Coverage Info") (td () "No Coverage Info")
(td () "0.00") (td () "0.00")
(td () "0.00")))) (td () "0.00"))))
(test-begin (check-equal? (tr:file-report "foo.rkt" (list 10 10) #f) (test-begin (check-equal? (tr:file-report "foo.rkt" (list 10 10) #t)
'(tr ((class "file-info")) '(tr ((class "file-info stripe"))
(td ([class "file-name"]) (a ((href "foo.html")) "foo.rkt")) (td ([class "file-name"]) (a ((href "foo.html")) "foo.rkt"))
(td () "100.00") (td () "100.00")
(td () "10.00") (td () "10.00")
(td () "10.00"))))) (td () "10.00")))))
;; Path -> String
;; Generate a link to the coverage report
(define (coverage-report-link path) (define (coverage-report-link path)
(define local-file (find-relative-path (current-directory) path)) (define local-file (find-relative-path (current-directory) path))
(path->string (path-replace-suffix local-file ".html"))) (path->string (path-replace-suffix local-file ".html")))
(module+ test
(test-begin
(check-equal? (coverage-report-link "format-utils.rkt")
"format-utils.html")))
;; Percentage ;; Percentage
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;