better api
This commit is contained in:
parent
35f9058d6e
commit
48a967512e
33
cover.rkt
33
cover.rkt
|
@ -1,8 +1,9 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(provide test-files! eval-expression! eval-module!
|
(provide test-files! cover-module!
|
||||||
initialize-cover-environment! clear-coverage!
|
make-clean-cover-environment clear-coverage!
|
||||||
get-test-coverage
|
get-test-coverage
|
||||||
current-cover-environment environment?)
|
current-cover-environment environment?
|
||||||
|
environment-compile environment-namespace)
|
||||||
|
|
||||||
#|
|
#|
|
||||||
|
|
||||||
|
@ -36,7 +37,8 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
|
||||||
|
|
||||||
;; Test files and build coverage map
|
;; Test files and build coverage map
|
||||||
;; returns true if no tests reported as failed, and no files errored.
|
;; returns true if no tests reported as failed, and no files errored.
|
||||||
(define (test-files! #:submod [submod-name 'test] . files)
|
(define (test-files! #:submod [submod-name 'test] #:env [env (current-cover-environment)] . files)
|
||||||
|
(parameterize ([current-cover-environment env])
|
||||||
(define abs
|
(define abs
|
||||||
(for/list ([p (in-list files)])
|
(for/list ([p (in-list files)])
|
||||||
(if (list? p)
|
(if (list? p)
|
||||||
|
@ -78,20 +80,16 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
|
||||||
(run-file the-file submod-name))))
|
(run-file the-file submod-name))))
|
||||||
(vprintf "ran ~s\n" files)
|
(vprintf "ran ~s\n" files)
|
||||||
(remove-unneeded-results! abs-names)
|
(remove-unneeded-results! abs-names)
|
||||||
(not tests-failed))
|
(not tests-failed)))
|
||||||
|
|
||||||
;; ModulePath -> Void
|
;; ModulePath -> Void
|
||||||
;; visit and instantiate the given module path in the cover environment
|
;; visit and instantiate the given module path in the cover environment
|
||||||
(define (eval-module! to-run)
|
(define (cover-module! to-run [env (current-cover-environment)])
|
||||||
(eval-expression! (make-dyn-req-expr to-run)))
|
(parameterize* ([current-cover-environment env]
|
||||||
|
[current-load/use-compiled (make-cover-load/use-compiled #f)]
|
||||||
;; Any -> Any
|
|
||||||
;; Evaluate the expression in the testing namespace with the cover's compiler
|
|
||||||
(define (eval-expression! e)
|
|
||||||
(parameterize ([current-load/use-compiled (make-cover-load/use-compiled #f)]
|
|
||||||
[current-compile (get-compile)]
|
[current-compile (get-compile)]
|
||||||
[current-namespace (get-namespace)])
|
[current-namespace (get-namespace)])
|
||||||
(eval e)))
|
(eval (make-dyn-req-expr to-run))))
|
||||||
|
|
||||||
;;; ---------------------- Running Aux ---------------------------------
|
;;; ---------------------- Running Aux ---------------------------------
|
||||||
|
|
||||||
|
@ -179,9 +177,10 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
|
||||||
;;; ---------------------- Environments ---------------------------------
|
;;; ---------------------- Environments ---------------------------------
|
||||||
|
|
||||||
(define (clear-coverage!)
|
(define (clear-coverage!)
|
||||||
(current-cover-environment (initialize-cover-environment! (make-base-namespace))))
|
(current-cover-environment (make-clean-cover-environment)))
|
||||||
|
|
||||||
(define (initialize-cover-environment! ns)
|
(define (make-clean-cover-environment)
|
||||||
|
(define ns (make-base-namespace))
|
||||||
(parameterize ([current-namespace ns])
|
(parameterize ([current-namespace ns])
|
||||||
(namespace-require 'cover/coverage)
|
(namespace-require 'cover/coverage)
|
||||||
(namespace-require 'cover/strace)
|
(namespace-require 'cover/strace)
|
||||||
|
@ -250,7 +249,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
|
||||||
out)
|
out)
|
||||||
|
|
||||||
(define current-cover-environment
|
(define current-cover-environment
|
||||||
(make-parameter (initialize-cover-environment! (make-base-namespace))))
|
(make-parameter (make-clean-cover-environment)))
|
||||||
|
|
||||||
;; here live tests for actually saving compiled files
|
;; here live tests for actually saving compiled files
|
||||||
(module+ test
|
(module+ test
|
||||||
|
@ -261,7 +260,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
|
||||||
"tests/compiled/prog_rkt.zo"
|
"tests/compiled/prog_rkt.zo"
|
||||||
"tests/compiled/prog_rkt.dep"))
|
"tests/compiled/prog_rkt.dep"))
|
||||||
(test-begin
|
(test-begin
|
||||||
(parameterize ([current-cover-environment (initialize-cover-environment! (make-base-namespace))])
|
(parameterize ([current-cover-environment (make-clean-cover-environment)])
|
||||||
(for-each (lambda (f) (when (file-exists? f) (delete-file f)))
|
(for-each (lambda (f) (when (file-exists? f) (delete-file f)))
|
||||||
compiled)
|
compiled)
|
||||||
(check-false (ormap file-exists? compiled))
|
(check-false (ormap file-exists? compiled))
|
||||||
|
|
21
main.rkt
21
main.rkt
|
@ -2,24 +2,32 @@
|
||||||
(require "cover.rkt" "format.rkt" "private/contracts.rkt" "private/format-utils.rkt"
|
(require "cover.rkt" "format.rkt" "private/contracts.rkt" "private/format-utils.rkt"
|
||||||
"private/raw.rkt" racket/contract)
|
"private/raw.rkt" racket/contract)
|
||||||
|
|
||||||
|
(define (not-impersonated/c c)
|
||||||
|
(and/c (lambda (v) (not (impersonator? v)))
|
||||||
|
c))
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
(contract-out
|
(contract-out
|
||||||
[coverage/c contract?]
|
[coverage/c contract?]
|
||||||
|
|
||||||
[file-coverage/c contract?]
|
[file-coverage/c contract?]
|
||||||
[test-files! (->* () (#:submod symbol?)
|
[test-files! (->* () (#:submod symbol?
|
||||||
|
#:env environment?)
|
||||||
#:rest
|
#:rest
|
||||||
(listof (or/c (or/c path-string? input-port?)
|
(listof (or/c (or/c path-string? input-port?)
|
||||||
(list/c (or/c path-string? input-port?)
|
(list/c (or/c path-string? input-port?)
|
||||||
(and/c (lambda (v) (not (impersonator? v)))
|
(not-impersonated/c
|
||||||
(vectorof string? #:immutable #t)))))
|
(vectorof (not-impersonated/c string?) #:immutable #t)))))
|
||||||
any)]
|
any)]
|
||||||
[eval-expression! (-> any/c any)]
|
[cover-module! (->* (module-path?) (environment?) any)]
|
||||||
[eval-module! (-> module-path? any)]
|
|
||||||
|
|
||||||
[environment? (-> any/c any/c)]
|
[environment? (-> any/c any/c)]
|
||||||
|
[environment-namespace (-> environment? namespace?)]
|
||||||
|
[environment-compile
|
||||||
|
(-> environment? (any/c boolean? . -> . compiled-expression?))]
|
||||||
|
|
||||||
[clear-coverage! (-> any)]
|
[clear-coverage! (-> any)]
|
||||||
[initialize-cover-environment! (-> namespace? 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 (-> coverage/c)]
|
||||||
|
@ -30,6 +38,7 @@
|
||||||
(->* (exact-positive-integer?)
|
(->* (exact-positive-integer?)
|
||||||
(#:byte? boolean?)
|
(#:byte? boolean?)
|
||||||
(or/c 'covered 'uncovered 'irrelevant)))]
|
(or/c 'covered 'uncovered 'irrelevant)))]
|
||||||
|
|
||||||
[generate-coveralls-coverage coverage-gen/c]
|
[generate-coveralls-coverage coverage-gen/c]
|
||||||
[generate-html-coverage coverage-gen/c]
|
[generate-html-coverage coverage-gen/c]
|
||||||
[generate-raw-coverage coverage-gen/c]))
|
[generate-raw-coverage coverage-gen/c]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user