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

Merge pull request #70 from florence/coverage-type

Browse Source 
Change the coverage object type
This commit is contained in:
Spencer Florence 2015-05-20 11:13:09 -05:00
commit 30195b87a2
15 changed files with 195 additions and 189 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
cover.rkt
View File

@ -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 <pkgs>/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))

6
main.rkt
View File

@ -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]

8
private/contracts.rkt
View File

@ -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))

32
private/coveralls.rkt
View File

@ -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)]

8
private/file-utils.rkt
View File

@ -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")

87
private/format-utils.rkt
View File

@ -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)))))

56
private/html/html.rkt
View File

@ -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))

6
private/raw.rkt
View File

@ -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)))))

24
raco.rkt
View File

@ -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

71
scribblings/api.scrbl
View File

@ -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.}

2
tests/do-reader.rkt
View File

@ -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))))

3
tests/do-syntax.rkt
View File

@ -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)))

22
tests/error.rkt
View File

@ -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))

11
tests/main.rkt
View File

@ -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!))))

4
tests/test-cross-phase-persist.rkt
View File

@ -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)))