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)))) (->absolute p))))
(define abs-paths (map (lambda (p) (if (list? p) (first p) p)) abs)) (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)] (parameterize ([current-load/use-compiled (make-cover-load/use-compiled abs-paths)]
[current-output-port [current-output-port
(if (verbose) (current-output-port) (open-output-nowhere))]) (if (verbose) (current-output-port) (open-output-nowhere))])
(define tests-failed #f) (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)) (define submod `(submod ,file ,submod-name))
(run-mod (if (module-declared? submod #t) submod file))))) (run-mod (if (module-declared? submod #t) submod file)))))
(vprintf "ran ~s\n" paths) (vprintf "ran ~s\n" paths)
(remove-unneeded-results abs-paths) (remove-unneeded-results! abs-paths)
(not tests-failed))) (not tests-failed)))
;; ModulePath -> Void ;; 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?))) (compile to-compile immediate-eval?)))
cover-compile) 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)) (define c (get-raw-coverage))
(for ([s (in-list (hash-keys c))] (for ([s (in-list (hash-keys c))]
#:when (not (member (srcloc-source s) paths))) #:when (not (member (srcloc-source s) paths)))

5
private/file-utils.rkt
View File

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

31
private/html.rkt
View File

@ -18,7 +18,7 @@
(module+ test (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 root "..")
(define-runtime-path tests/basic/prog.rkt "../tests/basic/prog.rkt") (define-runtime-path tests/basic/prog.rkt "../tests/basic/prog.rkt")
(define (mock-covered? pos) (define (mock-covered? pos)
@ -32,6 +32,15 @@
(define fs (get-files coverage dir)) (define fs (get-files coverage dir))
(write-files fs) (write-files fs)
(move-support-files! dir)) (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 (get-files coverage dir)
(define file-list (define file-list
@ -79,6 +88,7 @@
"coverage/tests/basic")) "coverage/tests/basic"))
(clear-coverage!))))) (clear-coverage!)))))
;; (Listof (list file-path directory-path xexpr)) -> Void
(define (write-files f) (define (write-files f)
(for ([l (in-list f)]) (for ([l (in-list f)])
(match-define (list f d e) l) (match-define (list f d e) l)
@ -87,10 +97,29 @@
(with-output-to-file f (with-output-to-file f
#:exists 'replace #:exists 'replace
(thunk (write-xexpr e))))) (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-runtime-path css "main.css")
(define (move-support-files! dir) (define (move-support-files! dir)
(copy-file css (build-path dir "main.css") #t)) (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 ;; FileCoverage PathString PathString -> Xexpr
(define (make-html-file coverage path path-to-css) (define (make-html-file coverage path path-to-css)

17
raco.rkt
View File

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

2
tests/main.rkt
View File

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