diff --git a/cover.rkt b/cover.rkt index 6384030..0a2009c 100644 --- a/cover.rkt +++ b/cover.rkt @@ -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))) diff --git a/private/file-utils.rkt b/private/file-utils.rkt index b19db77..c85da2f 100644 --- a/private/file-utils.rkt +++ b/private/file-utils.rkt @@ -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 "/")]) diff --git a/private/html.rkt b/private/html.rkt index 3a27918..ff63538 100644 --- a/private/html.rkt +++ b/private/html.rkt @@ -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) + ""))) + (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) diff --git a/raco.rkt b/raco.rkt index d74b35f..ce3783f 100644 --- a/raco.rkt +++ b/raco.rkt @@ -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]) diff --git a/tests/main.rkt b/tests/main.rkt index f59f13a..dd0fcc4 100644 --- a/tests/main.rkt +++ b/tests/main.rkt @@ -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!))))