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

fixed cover rackunit instance bleeding into other instances

Browse Source
This commit is contained in:
Spencer Florence 2015-01-11 12:58:25 -05:00
parent d09935ab60
commit 73f14bf899
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
cover.rkt
View File

@ -38,7 +38,7 @@
(set! tests-failed #t) (set! tests-failed #t)
(error-display x))]) (error-display x))])
(parameterize* ([current-namespace ns] (parameterize* ([current-namespace ns]
[current-check-handler [(get-check-handler-parameter)
(lambda x (lambda x
(set! tests-failed #t) (set! tests-failed #t)
(vprintf "file ~s had failed tests\n" p) (vprintf "file ~s had failed tests\n" p)
@ -102,13 +102,13 @@
;(dict-clear! coverage) ;(dict-clear! coverage)
(set! ns (make-base-namespace)) (set! ns (make-base-namespace))
;(namespace-attach-module (current-namespace) cov ns) ;(namespace-attach-module (current-namespace) cov ns)
(namespace-attach-module (current-namespace) 'rackunit ns)
(parameterize ([current-namespace ns]) (parameterize ([current-namespace ns])
(namespace-require `(file ,(path->string cov))) (namespace-require `(file ,(path->string cov)))
(namespace-require `(file ,(path->string strace))) (namespace-require `(file ,(path->string strace)))
(namespace-require 'rackunit)) (namespace-require 'rackunit))
(load-annotate-top!) (load-annotate-top!)
(load-raw-coverage!)) (load-raw-coverage!)
(load-current-check-handler!))
;; -> [Hashof PathString (Listof (List Boolean srcloc))] ;; -> [Hashof PathString (Listof (List Boolean srcloc))]
;; 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
@ -177,6 +177,12 @@
(define (load-raw-coverage!) (define (load-raw-coverage!)
(set! raw-cover (get-ns-var 'coverage))) (set! raw-cover (get-ns-var 'coverage)))
(define cch #f)
(define (load-current-check-handler!)
(set! cch (get-ns-var 'current-check-handler)))
(define (get-check-handler-parameter)
(or cch (unloaded-error)))
(define (unloaded-error) (define (unloaded-error)
(error 'cover "Test coverage not loaded.")) (error 'cover "Test coverage not loaded."))