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

test all the things

Browse Source
This commit is contained in:
Spencer Florence 2015-01-25 10:10:02 -05:00
parent eac3e05527
commit c85b91cb9a
5 changed files with 75 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
cover.rkt
View File

@ -40,7 +40,6 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(->absolute p))))
(define abs-paths (map (lambda (p) (if (list? p) (first p) p)) abs))
(parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-paths)]
[current-output-port
(if (verbose) (current-output-port) (open-output-nowhere))])
(define tests-failed #f)
@ -70,7 +69,7 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(define submod `(submod ,file ,submod-name))
(run-mod (if (module-declared? submod #t) submod file)))))
(vprintf "ran ~s\n" paths)
(remove-unneeded-results abs-paths)
(remove-unneeded-results! abs-paths)
(not tests-failed)))
;; ModulePath -> Void
@ -130,7 +129,9 @@ in "coverage.rkt". This raw coverage information is converted to a usable form b
(compile to-compile immediate-eval?)))
cover-compile)
(define (remove-unneeded-results paths)
;; [Listof PathString] -> Void
;; remove any files not in paths from the raw coverage
(define (remove-unneeded-results! paths)
(define c (get-raw-coverage))
(for ([s (in-list (hash-keys c))]
#:when (not (member (srcloc-source s) paths)))

15
private/file-utils.rkt
View File

@ -5,12 +5,13 @@
;; PathString -> Path
(define (->relative path)
(if (relative-path? path)
(build-path path)
(let-values ([(_ lst)
(split-at (explode-path path)
(length (explode-path (current-directory))))])
(apply build-path lst))))
(simplify-path
(if (relative-path? path)
(build-path path)
(let-values ([(_ lst)
(split-at (explode-path path)
(length (explode-path (current-directory))))])
(apply build-path lst)))))
(module+ test
(parameterize ([current-directory (build-path "/test")])
@ -21,7 +22,7 @@
(define (->absolute path)
(if (absolute-path? path)
(if (string? path) path (path->string path))
(path->string (simplify-path path))
(path->string (simplify-path (build-path (current-directory) path)))))
(module+ test
(parameterize ([current-directory (build-path "/")])

31
private/html.rkt
View File

@ -18,7 +18,7 @@
(module+ test
(require rackunit "../cover.rkt" racket/runtime-path racket/set)
(require rackunit "../cover.rkt" racket/runtime-path racket/set "file-utils.rkt")
(define-runtime-path root "..")
(define-runtime-path tests/basic/prog.rkt "../tests/basic/prog.rkt")
(define (mock-covered? pos)
@ -32,6 +32,15 @@
(define fs (get-files coverage dir))
(write-files fs)
(move-support-files! dir))
(module+ test
(after
(parameterize ([current-directory root] [verbose #t])
(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)
(check-true (file-exists? (build-path temp-dir "tests/basic/prog.html"))))
(clear-coverage!)))
(define (get-files coverage dir)
(define file-list
@ -79,6 +88,7 @@
"coverage/tests/basic"))
(clear-coverage!)))))
;; (Listof (list file-path directory-path xexpr)) -> Void
(define (write-files f)
(for ([l (in-list f)])
(match-define (list f d e) l)
@ -87,10 +97,29 @@
(with-output-to-file f
#:exists 'replace
(thunk (write-xexpr e)))))
(module+ test
(test-begin
(define temp-dir (make-temporary-file "covertmp~a" 'directory))
(define xexpr '(body ()))
(define dir (build-path temp-dir "x"))
(define file (build-path dir "y.html"))
(write-files (list (list file dir xexpr)))
(check-equal? (file->string file)
"<body></body>")))
(define-runtime-path css "main.css")
(define (move-support-files! dir)
(copy-file css (build-path dir "main.css") #t))
(module+ test
(test-begin
(define temp-dir (make-temporary-file "covertmp~a" 'directory))
(define dir (build-path temp-dir "x"))
(define final-path (build-path dir "main.css"))
(make-directory* dir)
(move-support-files! dir)
(check-equal? (file->string final-path)
(file->string css))))
;; FileCoverage PathString PathString -> Xexpr
(define (make-html-file coverage path path-to-css)

25
raco.rkt
View File

@ -102,19 +102,24 @@
(define-runtime-path root ".")
(define-runtime-path private "private")
(define-runtime-path main.rkt "main.rkt")
(parameterize ([current-directory root])
(define out
(set "main.rkt"
"private/coveralls.rkt"
"private/contracts.rkt"
"private/html.rkt"
"private/format-utils.rkt"
"private/file-utils.rkt"
"private/shared.rkt"
"private/raw.rkt"))
(define (do-test ->)
(parameterize ([current-directory root])
(check-equal? (list->set
(map (compose path->string ->relative)
(expand-directories (list (path->string main.rkt)
(->relative (path->string private))))))
(set "main.rkt"
"private/coveralls.rkt"
"private/contracts.rkt"
"private/html.rkt"
"private/format-utils.rkt"
"private/file-utils.rkt"
"private/shared.rkt"
"private/raw.rkt"))))
(->(path->string private))))))
out)))
(do-test ->relative)
(do-test ->absolute))
;; -> (HorribyNestedListsOf (or PathString (list path-string vector))
(define (expand-directory exts [omit-paths null] [args null])

2
tests/main.rkt
View File

@ -73,7 +73,7 @@
(after
(test-files! (->absolute prog.rkt))
(define abs (get-test-coverage))
(test-files! (->relative prog.rkt))
(test-files! (build-path (->relative prog.rkt)))
(define rel (get-test-coverage))
(check-equal? abs rel)
(clear-coverage!))))