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

got module running working. tests broken

Browse Source
This commit is contained in:
Spencer Florence 2015-02-16 18:20:10 -05:00
parent 48a967512e
commit b313b99bae
2 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
cover.rkt
View File

@ -19,6 +19,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
syntax/modcode syntax/modcode
racket/function racket/function
syntax/modread syntax/modread
syntax/modresolve
syntax/parse syntax/parse
unstable/syntax unstable/syntax
racket/bool racket/bool
@ -82,11 +83,13 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(remove-unneeded-results! abs-names) (remove-unneeded-results! abs-names)
(not tests-failed))) (not tests-failed)))
;; ModulePath -> Void ;; ResolvedModulePath -> Void
;; visit and instantiate the given module path in the cover environment ;; visit and instantiate the given module path in the cover environment
(define (cover-module! to-run [env (current-cover-environment)]) (define (cover-module! p [env (current-cover-environment)])
(define modpath (->absolute p))
(define to-run `(file ,modpath))
(parameterize* ([current-cover-environment env] (parameterize* ([current-cover-environment env]
[current-load/use-compiled (make-cover-load/use-compiled #f)] [current-load/use-compiled (make-cover-load/use-compiled (list modpath))]
[current-compile (get-compile)] [current-compile (get-compile)]
[current-namespace (get-namespace)]) [current-namespace (get-namespace)])
(eval (make-dyn-req-expr to-run)))) (eval (make-dyn-req-expr to-run))))
@ -231,22 +234,23 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
;; returns a hash of file to a list, where the first of the list is if ;; returns a hash of file to a list, where the first of the list is if
;; that srcloc was covered or not ;; that srcloc was covered or not
;; based on <pkgs>/drracket/drracket/private/debug.rkt ;; based on <pkgs>/drracket/drracket/private/debug.rkt
(define (get-test-coverage) (define (get-test-coverage [env (current-cover-environment)])
(vprintf "generating test coverage\n") (parameterize ([current-cover-environment env])
(vprintf "generating test coverage\n")
;; filtered : (listof (list boolean srcloc)) ;; filtered : (listof (list boolean srcloc))
;; remove redundant expressions ;; remove redundant expressions
(define filtered (hash-map (get-raw-coverage) (λ (k v) (list v k)))) (define filtered (hash-map (get-raw-coverage) (λ (k v) (list v k))))
(define out (make-hash)) (define out (make-hash))
(for ([v (in-list filtered)]) (for ([v (in-list filtered)])
(define file (srcloc-source (cadr v))) (define file (srcloc-source (cadr v)))
(hash-update! out (hash-update! out
file file
(lambda (l) (cons v l)) (lambda (l) (cons v l))
null)) null))
out) out))
(define current-cover-environment (define current-cover-environment
(make-parameter (make-clean-cover-environment))) (make-parameter (make-clean-cover-environment)))

4
main.rkt
View File

@ -19,7 +19,7 @@
(not-impersonated/c (not-impersonated/c
(vectorof (not-impersonated/c string?) #:immutable #t))))) (vectorof (not-impersonated/c string?) #:immutable #t)))))
any)] any)]
[cover-module! (->* (module-path?) (environment?) any)] [cover-module! (->* (path-string?) (environment?) any)]
[environment? (-> any/c any/c)] [environment? (-> any/c any/c)]
[environment-namespace (-> environment? namespace?)] [environment-namespace (-> environment? namespace?)]
@ -30,7 +30,7 @@
[make-clean-cover-environment (-> environment?)] [make-clean-cover-environment (-> environment?)]
[current-cover-environment (parameter/c environment?)] [current-cover-environment (parameter/c environment?)]
[get-test-coverage (-> coverage/c)] [get-test-coverage (->* () (environment?) coverage/c)]
[irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))] [irrelevant-submodules (parameter/c (or/c #f (listof symbol?)))]
[make-covered? [make-covered?