diff --git a/cover.rkt b/cover.rkt index 686f7fb..60bd56e 100644 --- a/cover.rkt +++ b/cover.rkt @@ -3,7 +3,8 @@ make-cover-environment clear-coverage! get-test-coverage current-cover-environment environment? - environment-compile environment-namespace) + environment-compile environment-namespace + coverage-wrapper-map) #| @@ -32,6 +33,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b racket/port "private/shared.rkt" "private/file-utils.rkt" + "private/format-utils.rkt" "strace.rkt") ;; An environment has: @@ -189,13 +191,8 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b (define (clear-coverage!) (current-cover-environment (make-cover-environment))) -(define (make-kernel-namespace) - (define ns (make-empty-namespace)) - (define cns (current-namespace)) - (namespace-attach-module cns ''#%builtin ns) - ns) - -(define (make-cover-environment [ns (make-kernel-namespace)]) +(define (make-cover-environment [ns (make-empty-namespace)]) + (kernelize-namespace! ns) (parameterize ([current-namespace ns]) (define ann (load-annotate-top)) (environment @@ -204,6 +201,10 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b ann (load-raw-coverage)))) +(define (kernelize-namespace! ns) + (define cns (current-namespace)) + (namespace-attach-module cns ''#%builtin ns)) + (define (get-annotate-top) (get-val environment-ann-top)) (define (load-annotate-top) @@ -217,13 +218,6 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b (define (load-cover-name) (dynamic-require 'cover/coverage 'cover-name)) -(define (load-cover-setter) - (dynamic-require 'cover/coverage '!)) - -#; -(define (get-check-handler-parameter) - (namespace-variable-value (module->namespace 'rackunit) - 'current-check-handler)) (define (get-namespace) (get-val environment-namespace)) @@ -234,7 +228,10 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b (define (get-val access) (access (current-cover-environment))) -;; -> [Hashof PathString (Listof (List Boolean srcloc))] +(struct coverage-wrapper (map function) + #:property prop:procedure (struct-field-index function)) + +;; -> coverage/c ;; returns a hash of file to a list, where the first of the list is if ;; that srcloc was covered or not ;; based on /drracket/drracket/private/debug.rkt @@ -255,7 +252,16 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b (lambda (l) (cons v l)) null)) ;; Make the hash map immutable - (for/hash ([(k v) (in-hash out)]) (values k v)))) + (define coverage (for/hash ([(k v) (in-hash out)]) (values k v))) + (define file-map (make-hash)) + (coverage-wrapper + coverage + (lambda (key location) + (define f + (hash-ref! file-map key + (lambda () + (make-covered? coverage key)))) + (f location))))) (define current-cover-environment (make-parameter (make-cover-environment))) @@ -287,7 +293,6 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b racket/format racket/lazy-require) ;; break cyclic dependency in testing - (lazy-require ["private/format-utils.rkt" (make-covered?)]) (define-runtime-path simple-multi/2.rkt "tests/simple-multi/2.rkt") (define env (make-cover-environment)) (define ns (environment-namespace env)) @@ -302,8 +307,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b (namespace-require `(file ,modpath))) (check-equal? (eval `(two)) 10) (define x (get-test-coverage env)) - (define covered? - (make-covered? (hash-ref x file) file)) + (define covered? (curry x file)) (for ([_ (in-string (file->string file))] [i (in-naturals 1)]) (define c (covered? i)) diff --git a/main.rkt b/main.rkt index d951225..c51cba5 100644 --- a/main.rkt +++ b/main.rkt @@ -10,7 +10,6 @@ (contract-out [coverage/c contract?] - [file-coverage/c contract?] [test-files! (->* () (#:submod symbol? #:env environment?) #:rest @@ -32,11 +31,6 @@ [get-test-coverage (->* () (environment?) coverage/c)] [irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))] - [make-covered? - (-> file-coverage/c path-string? - (->* (exact-positive-integer?) - (#:byte? boolean?) - (or/c 'covered 'uncovered 'irrelevant)))] [generate-coveralls-coverage coverage-gen/c] [generate-html-coverage coverage-gen/c] diff --git a/private/contracts.rkt b/private/contracts.rkt index 01b618f..f2b6878 100644 --- a/private/contracts.rkt +++ b/private/contracts.rkt @@ -1,8 +1,8 @@ #lang racket/base -(provide coverage/c file-coverage/c coverage-gen/c) +(provide coverage/c coverage-gen/c) (require racket/contract) -(define file-coverage/c (listof (list/c boolean? srcloc?))) ;; if its a file path, will be an absolute path -(define coverage/c (hash/c any/c file-coverage/c)) -(define coverage-gen/c (->* (coverage/c) (path-string?) any)) +(define coverage/c (-> any/c exact-positive-integer? + (or/c 'covered 'uncovered 'irrelevant))) +(define coverage-gen/c (->* (coverage/c (listof path-string?)) (path-string?) any)) diff --git a/private/coveralls.rkt b/private/coveralls.rkt index d81037f..4e6cf28 100644 --- a/private/coveralls.rkt +++ b/private/coveralls.rkt @@ -10,7 +10,7 @@ racket/runtime-path racket/string racket/system - "format-utils.rkt" + "file-utils.rkt" "shared.rkt") @@ -35,14 +35,14 @@ ;; Coverage [path-string] -> Void (define-runtime-path post "curl.sh") -(define (generate-coveralls-coverage coverage [dir "coverage"]) - (send-coveralls-info (generate-and-save-data coverage dir))) +(define (generate-coveralls-coverage coverage files [dir "coverage"]) + (send-coveralls-info (generate-and-save-data coverage files dir))) -(define (generate-and-save-data coverage dir) +(define (generate-and-save-data coverage files dir) (make-directory* dir) (define coverage-path dir) (define coverage-file (build-path coverage-path "coverage.json")) - (define data (generate-coveralls-report coverage)) + (define data (generate-coveralls-report coverage files)) (vprintf "writing json to file ~s\n" coverage-file) (with-output-to-file coverage-file (thunk (write-json data)) @@ -57,7 +57,7 @@ (define temp-dir (make-temporary-file "covertmp~a" 'directory)) (test-files! tests/prog.rkt) (define coverage (get-test-coverage)) - (define data-file (generate-and-save-data coverage temp-dir)) + (define data-file (generate-and-save-data coverage (list (->absolute tests/prog.rkt)) temp-dir)) (define rfile (build-path temp-dir "coverage.json")) (check-equal? data-file rfile) (check-true (file-exists? rfile))))) @@ -75,8 +75,8 @@ (unless result (error 'coveralls "request to coveralls failed")))) -(define (generate-coveralls-report coverage) - (define json (generate-source-files coverage)) +(define (generate-coveralls-report coverage files) + (define json (generate-source-files coverage files)) (define build-type (determine-build-type)) (define git-info (get-git-info)) (hash-merge json (hash-merge build-type git-info))) @@ -89,7 +89,8 @@ (test-files! (path->string (simplify-path tests/prog.rkt))) (define coverage (get-test-coverage)) (define report - (with-env ("COVERALLS_REPO_TOKEN" "abc") (generate-coveralls-report coverage))) + (with-env ("COVERALLS_REPO_TOKEN" "abc") + (generate-coveralls-report coverage (list (->absolute file))))) (check-equal? (hash-ref report 'source_files) (list (hasheq 'source (file->string tests/prog.rkt) @@ -124,13 +125,13 @@ 'service_job_id "abc" 'repo_token #f)))) -;; Coverage -> JSexpr +;; Coverage (Listof PathString) -> JSexpr ;; Generates a string that represents a valid coveralls json_file object -(define (generate-source-files coverage) +(define (generate-source-files coverage files) (define src-files - (for/list ([file (in-list (hash-keys coverage))] + (for/list ([file (in-list files)] #:when (absolute-path? file)) - (define local-file (path->string (find-relative-path (current-directory) file))) + (define local-file (path->string (->relative file))) (define src (file->string file)) (define c (line-coverage coverage file)) (hasheq 'source src 'coverage c 'name local-file))) @@ -144,7 +145,7 @@ (test-files! (path->string (simplify-path tests/prog.rkt))) (define coverage (get-test-coverage)) (check-equal? - (generate-source-files coverage) + (generate-source-files coverage (list file)) (hasheq 'source_files (list (hasheq 'source (file->string tests/prog.rkt) 'coverage (line-coverage coverage file) @@ -156,9 +157,8 @@ ;; Coverage PathString Covered? -> [Listof CoverallsCoverage] ;; Get the line coverage for the file to generate a coverage report (define (line-coverage coverage file) - (define covered? (make-covered? (hash-ref coverage file) file)) + (define covered? (curry coverage file)) (define split-src (string-split (file->string file) "\n")) - (define file-coverage (hash-ref coverage file)) (define (process-coverage value rst-of-line) (case (covered? value) ['covered (if (equal? 'uncovered rst-of-line) rst-of-line 'covered)] diff --git a/private/file-utils.rkt b/private/file-utils.rkt index e24c71d..9119a9d 100644 --- a/private/file-utils.rkt +++ b/private/file-utils.rkt @@ -7,8 +7,8 @@ (define (->relative path) (build-path (find-relative-path - (current-directory) - path))) + (simple-form-path (current-directory)) + (simple-form-path path)))) (module+ test (parameterize ([current-directory (build-path "/test")]) @@ -19,8 +19,8 @@ (define (->absolute path) (if (absolute-path? path) - (path->string (simplify-path path)) - (path->string (simplify-path (build-path (current-directory) path))))) + (path->string (simple-form-path path)) + (path->string (simple-form-path (build-path (current-directory) path))))) (module+ test (parameterize ([current-directory (build-path "/")]) (check-equal? (->absolute "a") "/a") diff --git a/private/format-utils.rkt b/private/format-utils.rkt index c2d9cc0..86f4459 100644 --- a/private/format-utils.rkt +++ b/private/format-utils.rkt @@ -13,55 +13,57 @@ syntax/parse "shared.rkt") -(module+ test (require rackunit "../cover.rkt" racket/runtime-path racket/set)) +(module+ test (require rackunit racket/runtime-path racket/set)) -;;;;; a Coverage is the output of (get-test-coverage) -;;;;; a FileCoverage is the values of the hashmap from (get-test-coverage) +;;;;; a Coverage is the output of (hash-of any (listof (list boolean srcloc?))) ;;;;; utils ;;; a Cover is (U 'covered 'uncovered 'irrelevant) -;; [Hashof PathString [Hashof Natural Cover]] - -;; A Covered? is a [Nat [#:byte? Boolean] -> Cover] - -;; FileCoverage PathString #:ignored-submods (maybe (listof symbol)) -> Covered? -(define (make-covered? c path) +;; Coverage Any -> [Nat -> Cover] +(define (make-covered? coverage key) + (unless (hash-has-key? coverage key) + (error 'cover "no coverage information for ~s" key)) + (define c (hash-ref coverage key)) (define submods (irrelevant-submodules)) - (define vec - (list->vector (string->list (file->string path)))) - (define file/byte->str-offset (make-byte->str-offset vec)) (define file-location-coverage-cache - (coverage-cache-file path c submods)) - (lambda (loc #:byte? [byte? #f]) - (hash-ref file-location-coverage-cache (if (not byte?) loc (- loc (file/byte->str-offset loc))) - 'missing))) + (coverage-cache-file key c submods)) + (lambda (loc) + (hash-ref file-location-coverage-cache loc + 'irrelevant))) ;; (or/c #f (listof symbol)) (define irrelevant-submodules (make-parameter #f)) ;; Path FileCoverage -> [Hashof Natural Cover] ;; build a hash caching coverage info for that file -(define (coverage-cache-file f c submods) - (vprintf "caching coverage info for ~s\n" f) - (with-input-from-file f - (thunk - (define lexer - (maybe-wrap-lexer - (with-handlers ([exn:fail:read? (const racket-lexer)]) - (define f (read-language)) - (if f - (f 'color-lexer racket-lexer) - racket-lexer)))) - (define irrelevant? (make-irrelevant? lexer f submods)) - (define file-length (string-length (file->string f))) - (define cache - (for/hash ([i (in-range 1 (add1 file-length))]) - (values i - (cond [(irrelevant? i) 'irrelevant] - [else (raw-covered? i c)])))) - cache))) +(define (coverage-cache-file key c submods) + (vprintf "caching coverage info for ~s\n" key) + (if (not (path-string? key)) + (for/hash ([i (in-range 1 (biggest c))]) + (values i (raw-covered? i c))) + (with-input-from-file key + (thunk + (define lexer + (maybe-wrap-lexer + (with-handlers ([exn:fail:read? (const racket-lexer)]) + (define f (read-language)) + (if f + (f 'color-lexer racket-lexer) + racket-lexer)))) + (define irrelevant? (make-irrelevant? lexer key submods)) + (define file-length (string-length (file->string key))) + (define cache + (for/hash ([i (in-range 1 (add1 file-length))]) + (values i + (cond [(irrelevant? i) 'irrelevant] + [else (raw-covered? i c)])))) + cache)))) + +;; FileCoverage -> Natural +(define (biggest c) + (apply max (map second c))) (define (maybe-wrap-lexer lexer) (if (procedure-arity-includes? lexer 3) @@ -161,21 +163,26 @@ (loop (add1 s) (+ b l))]))) (module+ test + (require racket/lazy-require) + (lazy-require ["../cover.rkt" + (make-cover-environment + test-files! + get-test-coverage)]) + (define-runtime-path cover.rkt "../cover.rkt") + (define current-cover-environment + (dynamic-require cover.rkt 'current-cover-environment)) (define-runtime-path path2 "../tests/prog.rkt") (parameterize ([irrelevant-submodules #f]) (test-begin (parameterize ([current-cover-environment (make-cover-environment)]) (define f (path->string (simplify-path path2))) (test-files! f) - (define coverage (hash-ref (get-test-coverage) f)) - (define covered? (make-covered? coverage f)) + (define coverage (get-test-coverage)) + (define covered? (curry coverage f)) (check-equal? (covered? 14) 'irrelevant) - (check-equal? (covered? 14 #:byte? #t) 'irrelevant) (check-equal? (covered? 17) 'irrelevant) (check-equal? (covered? 28) 'irrelevant) (check-equal? (covered? 35) 'covered) - (check-equal? (covered? 50) 'uncovered) - (check-equal? (covered? 51 #:byte? #t) 'uncovered) (check-equal? (covered? 52) 'irrelevant) (check-equal? (covered? 53) 'irrelevant) (check-equal? (covered? 54) 'irrelevant))))) diff --git a/private/html/html.rkt b/private/html/html.rkt index 0ddaca5..9faa199 100644 --- a/private/html/html.rkt +++ b/private/html/html.rkt @@ -13,7 +13,6 @@ syntax/parse unstable/sequence (only-in xml write-xexpr) - "../format-utils.rkt" "../shared.rkt") @@ -27,9 +26,9 @@ [else 'uncovered]))) ;;; Coverage [PathString] -> Void -(define (generate-html-coverage coverage [d "coverage"]) +(define (generate-html-coverage coverage files [d "coverage"]) (define dir (simplify-path d)) - (define fs (get-files coverage dir)) + (define fs (get-files coverage files dir)) (define asset-path (build-path dir "assets/")) (write-files fs) (delete-directory/files asset-path #:must-exist? #f) @@ -40,13 +39,13 @@ (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) + (generate-html-coverage coverage (list (->absolute tests/basic/prog.rkt)) 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 files dir) (define file-list - (for/list ([(k v) (in-hash coverage)] + (for/list ([k (in-list files)] #:when (absolute-path? k)) (vprintf "building html coverage for: ~a\n" k) (define exploded (explode-path k)) @@ -58,14 +57,14 @@ (define output-file (apply build-path (append coverage-dir-list (list relative-output-file)))) (define output-dir (apply build-path coverage-dir-list)) - (define assets-path + (define assets-path (path->string (apply build-path (append (build-list (sub1 (length coverage-dir-list)) (const "..")) (list "assets/"))))) - (define xexpr (make-html-file (hash-ref coverage k) k assets-path)) + (define xexpr (make-html-file coverage k assets-path)) (list output-file output-dir xexpr))) - (define index (generate-index coverage)) + (define index (generate-index coverage files)) (cons (list (build-path dir "index.html") dir index) file-list)) @@ -77,7 +76,7 @@ (define d "coverage") (test-files! f) (define coverage (get-test-coverage)) - (define files (get-files coverage d)) + (define files (get-files coverage (list f) d)) (define (maybe-path->string p) (if (string? p) p (path->string p))) (check-equal? (list->set (map (compose maybe-path->string first) @@ -114,7 +113,7 @@ ;; FileCoverage PathString Path -> Xexpr (define (make-html-file coverage path assets-path) - (define covered? (make-covered? coverage path)) + (define covered? (curry coverage path)) (define cover-info (expression-coverage/file path covered?)) (define-values (covered total) (values (first cover-info) (second cover-info))) `(html () @@ -132,8 +131,8 @@ (test-begin (define f (path->string (simplify-path tests/basic/prog.rkt))) (test-files! f) - (define cov (hash-ref (get-test-coverage) f)) - (define covered? (make-covered? cov f)) + (define cov (get-test-coverage)) + (define covered? (curry cov f)) (check-equal? (make-html-file cov f "assets/") `(html () (head () @@ -156,8 +155,7 @@ (test-begin (define f (path->string (simplify-path tests/basic/prog.rkt))) (test-files! f) - (define cov (hash-ref (get-test-coverage) f)) - (define covered? (make-covered? cov f)) + (define covered? (curry (get-test-coverage) f)) (define lines (string-split (file->string f) "\n")) (check-equal? (file->html f covered?) `(div () @@ -230,10 +228,10 @@ ;; Index File ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Coverage PathString -> Xexpr +;; Coverage (Listof PathString) -> Xexpr ;; Generate the index html page for the given coverage information -(define (generate-index coverage) - (define expression-coverage (expression-coverage/all coverage)) +(define (generate-index coverage files) + (define expression-coverage (expression-coverage/all coverage files)) `(html (head () (meta ([charset "utf-8"])) @@ -338,11 +336,11 @@ ;; the first element is the number of covered expressions ;; the second element is the total number of expressions. This will never be 0. -;; Coverage -> [Hash FilePath ExpressionInfo] +;; Coverage (Listof PathString) -> [Hash FilePath ExpressionInfo] ;; returns a hash that maps file paths to an ExpressionInfo -(define (expression-coverage/all coverage) - (for/hash ([(file data) (in-hash coverage)]) - (values file (expression-coverage/file file (make-covered? data file))))) +(define (expression-coverage/all coverage files) + (for/hash ([file (in-list files)]) + (values file (expression-coverage/file file (curry coverage file))))) ;; FilePath Covered? -> ExpressionInfo ;; Takes a file path and a Covered? and @@ -352,27 +350,33 @@ ;; we don't need to look at the span because the coverage is expression based (define p (syntax-position e)) (if p - (covered? p #:byte? #t) + (covered? p) 'missing)) (define e (with-module-reading-parameterization - (thunk (with-input-from-file path read-syntax)))) + (thunk (with-input-from-file path + (lambda () + (port-count-lines! (current-input-port)) + (read-syntax)))))) + (define (ret e) (values (e->n e) (a->n e))) (define (a->n e) (case (is-covered? e) [(covered uncovered) 1] [else 0])) (define (e->n e) (if (eq? (is-covered? e) 'covered) 1 0)) + (define-values (covered total) (let recur ([e e]) (syntax-parse e [(v ...) (for/fold ([covered (e->n e)] [count (a->n e)]) - ([e (in-syntax e)]) - (define-values (cov cnt) (recur e)) + ([v (in-syntax e)]) + (define-values (cov cnt) (recur v)) (values (+ covered cov) (+ count cnt)))] [e:expr (ret #'e)] [_ (values 0 0)]))) + (list covered total)) diff --git a/private/raw.rkt b/private/raw.rkt index 17f62a4..ae3780a 100644 --- a/private/raw.rkt +++ b/private/raw.rkt @@ -1,7 +1,7 @@ #lang racket/base -(require racket/pretty) +(require racket/pretty "../cover.rkt") (provide generate-raw-coverage) -(define (generate-raw-coverage coverage [dir "coverage"]) +(define (generate-raw-coverage coverage files [dir "coverage"]) (with-output-to-file (build-path dir "coverage.rktl") #:exists 'replace - (lambda () (pretty-write coverage)))) + (lambda () (pretty-write (coverage-wrapper-map coverage))))) diff --git a/raco.rkt b/raco.rkt index 57052ed..1f81ad8 100644 --- a/raco.rkt +++ b/raco.rkt @@ -74,11 +74,12 @@ (hash-ref (get-formats) output-format (lambda _ (error 'cover "given unknown coverage output format: ~s" output-format)))) (printf "generating test coverage for ~s\n" files) - (define passed (keyword-apply test-files! '(#:submod) (list submod) files)) - (define coverage (remove-excluded-paths (get-test-coverage) exclude-paths)) + (define passed (apply test-files! #:submod submod files)) + (define coverage (get-test-coverage)) + (define cleaned-files (remove-excluded-paths files exclude-paths)) (printf "dumping coverage info into ~s\n" coverage-dir) (parameterize ([irrelevant-submodules irrel-submods]) - (generate-coverage coverage coverage-dir)) + (generate-coverage coverage cleaned-files coverage-dir)) (unless passed (printf "some tests failed\n"))) @@ -204,22 +205,23 @@ '("/Users/florence/playground/cover/tests/error-file.rkt"))) (check-false (should-omit? "/Test/t.rkt" '("/OtherDir")))) -;; Coverage -> Coverage -(define (remove-excluded-paths cover paths) - (for/hash ([(k v) (in-hash cover)] +;; (listof (U path (list Path Vector)) (listof path) -> (listof path-string) +(define (remove-excluded-paths files paths) + (define (->path p) (if (path-string? p) p (first p))) + (for/list ([k (in-list (map ->path files))] #:unless (and (is-excluded-path? k paths) (vprintf "excluding path ~s from output\n" k))) (vprintf "including path ~s in output\n" k) - (values k v))) + k)) (module+ test (parameterize ([current-directory (build-path "/tests")]) (check-equal? (remove-excluded-paths - (hash "/tests/tests/x.rkt" null - "/tests/x/tests/x/x.rkt" null - "/tests/x.rkt" null) + (list (list "/tests/tests/x.rkt" #()) + "/tests/x/tests/x/x.rkt" + "/tests/x.rkt") '("tests")) - (hash "/tests/x.rkt" null)))) + (list "/tests/x.rkt")))) ;; PathString [ListOf PathString]-> any/c diff --git a/scribblings/api.scrbl b/scribblings/api.scrbl index 39f142c..f76fbf5 100644 --- a/scribblings/api.scrbl +++ b/scribblings/api.scrbl @@ -11,20 +11,19 @@ functions of test coverage. @section[#:tag "higher"]{A High Level API} -@deftogether[(@defthing[coverage/c - contract? - #:value (hash/c any/c file-coverage/c)] - @defthing[file-coverage/c contract? #:value (listof (list/c boolean? srcloc?))])]{ +@defthing[coverage/c + contract? + #:value (-> any/c exact-positive-integer? + (or/c 'covered 'uncovered 'irrelevant))]{ +Coverage information is represented as a mapping from a file's key and a character +location to whether or not that location in the file was covered. -Coverage information is a hash map mapping absolute file paths to a list detailing the coverage of -that file. The file is keyed on the @racket[syntax-source] of the syntax objects from that -file. Usually this will be the absolute path to the file. The file coverage information is a list of -lists, mapping a boolean to a range of characters within the file. True means the @racket[srcloc] -structure represents an expression that was run, and False means the structure represents an -expression that was not run. Some expressions may not be represented directly in this coverage -information. For example, type annotations in @racketmodname[typed/racket] removed during macro -expansion and are thus neither run or not run. Note that the @racket[srcloc]s are one indexed, -meaning a @racket[1] represents the first character in the file.} +The files key is determined by what @racket[syntax-source] is on the syntax of the program after +reading it. Typically this is the @racket[string?] for of the absolute path of the file path. If +coverage was run manually, as in the @tech{Lower Lever API}, this value may be something +else. + +The character locations are @racket[1] indexed. @defproc[(test-files! (#:submod submod symbol? 'test) (files @@ -41,37 +40,32 @@ not wrapped by a @racket[chaperone?] or @racket[impersonator?], nor may its elem coverage information is still collected when test fail. Test coverage info is added to existing coverage info.} -@defproc[(clear-coverage! [environment environment? (current-coverage-environment)]) any]{ +@defproc[(clear-coverage! [environment environment? (current-cover-environment)]) any]{ Clears all coverage information.} -@defproc[(get-test-coverage [environment environment? (current-coverage-environment)]) coverage/c]{ +@defproc[(get-test-coverage [environment environment? (current-cover-environment)]) coverage/c]{ Gets the current coverage information.} -@defproc[(make-covered? (coverage file-coverage/c) (path path-string?)) - (->* (exact-positive-integer?) - (#:byte? boolean?) - (or/c 'covered 'uncovered 'irrelevant)) - ]{ -Given some location in a file and the -coverage information for that file @racket[make-covered?] returns -a functions that determines if some @racket[1] indexed character or byte location -in that file is covered. By default it checks character locations. -There are three possible results: @itemize[@item{@racket['irrelevant] --- The location is not -considered relevant to coverage information. It is either not in the coverage information; is in a -submodule specified by @racket[irrelevant-submodules]; is a @racket[begin-for-syntax] form; or lexes -(in the sense of that languages, @racket[_color-lexer]) as a comment or whitespace.} +There are three possible results for coverage: @itemize[@item{@racket['irrelevant] --- The location +is not considered relevant to coverage information. It is either not in the coverage information; +is in a submodule specified by @racket[irrelevant-submodules]; is a @racket[begin-for-syntax] form; +or lexes (in the sense of that language's @racket[_color-lexer]) as a comment or whitespace.} @item{@racket['covered] --- The location is not @racket['irrelevant] and is covered} @item{@racket['uncovered] --- The location is not @racket['uncovered] and is not covered}] } @defthing[irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))]{ -A parameter that controls with submodules are considered irrelevant by @racket[make-covered?]. It +A parameter that controls with submodules are considered irrelevant by @racket[get-test-coverage]. It defaults to @racket[#f], which tells @racket[make-covered?] to consider all submodules irrelevant. If its value is a list, then each element of that list is the name of a submodule to be considered irrelevant.} -@deftogether[(@defproc[(generate-coveralls-coverage (c coverage/c) (p path-string? "coverage")) any] - @defproc[(generate-html-coverage (c coverage/c) (p path-string? "coverage")) any])]{ +@deftogether[(@defproc[(generate-coveralls-coverage (c coverage/c) (files (listof path-string?)) + (p path-string? "coverage")) + any] + @defproc[(generate-html-coverage (c coverage/c) (files (listof path-string?)) + (p path-string? "coverage")) + any])]{ Generates coverage information in the coveralls and html formats. Equivalent to the specifications of the @Flag{c} argument to @exec{raco cover}. Both use @racket[make-covered?] to determine file @@ -81,18 +75,19 @@ coverage.} The high level API may not be enough for some applications. For example an IDE may need separate instances of the coverage table, or may need direct access to the namespace code is run in. For this -purpose @racket[cover] directly expose coverage environments. +purpose @racket[cover] directly expose coverage environments in its @deftech{Lower Lever API}. Coverage environments are values that package together a coverage namespace, a compiler for annotating code, and a coverage table to write coverage results to. All other coverage functions use -the @racket[current-coverage-environment] for code coverage, unless explicitly given a different +the @racket[current-cover-environment] for code coverage, unless explicitly given a different environment. @defproc[(environment? [v any/c]) any/c]{ Tests if the given value is a coverage environment.} -@defthing[current-coverage-environment (parameter/c environment?)]{ +@defparam[current-cover-environment environment environment? + #:value (make-cover-environment)]{ The current coverage environment. Defaults to an environment built from -@racket[make-base-namespace]} +@racket[make-empty-namespace].} @defproc[(environment-namespace [environment environment?]) namespace?]{ Get the namespace that coverage should be run in. This is the same namespace given to @racket[make-cover-environment]} @@ -102,7 +97,9 @@ Get the namespace that coverage should be run in. This is the same namespace giv Returns a value suitable for @racket[current-compile] that will compile code with coverage annotations. That code must be run in @racket[environment]'s namespace.} -@defproc[(make-cover-environment [namespace namespace? (make-base-namespace)]) environment?]{ +@defproc[(make-cover-environment [namespace namespace? (make-empty-namespace)]) environment?]{ Makes a coverage environment such that @racket[environment-namespace] will return -@racket[namespace], and @racket[namespace] will be set up to handle coverage information.} +@racket[namespace], and @racket[namespace] will be set up to handle coverage information. If +@racket[namespace] has been used in a different environment the two environments will share coverage +information.} diff --git a/tests/do-reader.rkt b/tests/do-reader.rkt index 1734890..f784110 100644 --- a/tests/do-reader.rkt +++ b/tests/do-reader.rkt @@ -6,5 +6,5 @@ (thunk (define r (path->string reader.rkt)) (test-files! r) - (define c (make-covered? (hash-ref (get-test-coverage) r) r)) + (define c (curry (get-test-coverage) r)) (c 10)))) diff --git a/tests/do-syntax.rkt b/tests/do-syntax.rkt index a86ffa5..4ba0ee4 100644 --- a/tests/do-syntax.rkt +++ b/tests/do-syntax.rkt @@ -7,8 +7,7 @@ (test-files! syntax.rkt) (define x (get-test-coverage)) (define c? - (make-covered? (hash-ref x (path->string syntax.rkt)) - (path->string syntax.rkt))) + (curry x (path->string syntax.rkt))) (for ([i (in-naturals 1)] [_ (in-string (file->string syntax.rkt))]) (check-not-eq? (c? i) 'uncovered (~a i))) diff --git a/tests/error.rkt b/tests/error.rkt index d06891e..2c17c9f 100644 --- a/tests/error.rkt +++ b/tests/error.rkt @@ -1,21 +1,21 @@ #lang racket -(require "../main.rkt" rackunit racket/runtime-path) +(require "../main.rkt" (only-in "../cover.rkt" coverage-wrapper-map) rackunit racket/runtime-path) (define-runtime-path error "error-file.rkt") (define-runtime-path main "main.rkt") (test-begin (after (define (do-test files) - (define o (open-output-string)) - (parameterize ([current-error-port o]) - (apply test-files! files)) - (define s (get-output-string o)) - (define c (get-test-coverage)) - (define covered (hash-keys c)) - (for-each - (lambda (x) (check-not-false (member x covered) s)) - files) - (clear-coverage!)) + (parameterize ([current-cover-environment (make-cover-environment)]) + (define o (open-output-string)) + (parameterize ([current-error-port o]) + (apply test-files! files)) + (define s (get-output-string o)) + (define c (get-test-coverage)) + (define covered (hash-keys (coverage-wrapper-map c))) + (for-each + (lambda (x) (check-not-false (member x covered) s)) + files))) (define files (map path->string (list error main))) (do-test files) (do-test (reverse files)) diff --git a/tests/main.rkt b/tests/main.rkt index 8c5e88c..7f02a3c 100644 --- a/tests/main.rkt +++ b/tests/main.rkt @@ -3,8 +3,8 @@ ;; for every .rkt file in those directories it loads ;; tests that file and checks its coverage against an ;; .rktl file of the same name -(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules - make-covered?) +(require (only-in cover test-files! clear-coverage! get-test-coverage irrelevant-submodules) + (only-in "../cover.rkt" coverage-wrapper-map) "../private/file-utils.rkt" racket/runtime-path rackunit) @@ -24,11 +24,10 @@ (define coverage (get-test-coverage)) (for ([(program cover) covered]) - (define actual-coverage (hash-ref coverage program)) (define-values (expected-coverage expected-uncoverage) (with-input-from-file cover (lambda () (values (ranges->numbers (read)) (ranges->numbers (read)))))) - (define covered? (make-covered? actual-coverage program)) + (define covered? (curry coverage program)) (define (test-range range type) (for ([i range]) (define v (covered? i)) @@ -66,8 +65,8 @@ (test-begin (after (test-files! (->absolute prog.rkt)) - (define abs (get-test-coverage)) + (define abs (coverage-wrapper-map (get-test-coverage))) (test-files! (build-path (->relative prog.rkt))) - (define rel (get-test-coverage)) + (define rel (coverage-wrapper-map (get-test-coverage))) (check-equal? abs rel) (clear-coverage!)))) diff --git a/tests/test-cross-phase-persist.rkt b/tests/test-cross-phase-persist.rkt index c6f8035..b5fcc08 100644 --- a/tests/test-cross-phase-persist.rkt +++ b/tests/test-cross-phase-persist.rkt @@ -1,6 +1,6 @@ #lang racket -(require cover rackunit racket/runtime-path) +(require cover rackunit racket/runtime-path (only-in "../cover.rkt" coverage-wrapper-map)) (define-runtime-path file "cross-phase-persist.rkt") (parameterize ([current-cover-environment (make-cover-environment)]) (test-files! file) - (check-equal? (get-test-coverage) (hash))) + (check-equal? (coverage-wrapper-map (get-test-coverage)) (hash)))