diff --git a/main.rkt b/main.rkt index b4da10b..22711d6 100644 --- a/main.rkt +++ b/main.rkt @@ -8,17 +8,18 @@ syntax/parse "coverage.rkt" "strace.rkt" - racket/runtime-path) + racket/runtime-path + rackunit) (define ns (make-base-namespace)) -(define-runtime-path cov "coverage.rkt") -(namespace-attach-module (current-namespace) cov ns) -;; PathString * -> Void +;; PathString * -> Boolean ;; Test files and build coverage map +;; returns true if all tests passed (define (test-files! . paths) + (clear-coverage!) (for ([p paths]) (let loop () (define-values (loc type) (get-module-path (build-path p))) @@ -31,12 +32,20 @@ (cons (build-path "compiled" "better-test") (use-compiled-file-paths))] [current-compile (make-better-test-compile)]) + (define tests-failed #f) (for ([p paths]) - (parameterize ([current-namespace ns]) + (define old-check (current-check-handler)) + (parameterize* ([current-namespace ns] + [current-check-handler + (lambda x + (set! tests-failed #t) + (apply old-check x))]) + (eval `(dynamic-require '(file ,p) #f)) (namespace-require `(file ,p)) (define submod `(submod (file ,p) test)) (when (module-declared? submod) - (namespace-require submod)))))) + (namespace-require submod)))) + (not tests-failed))) (define (make-better-test-compile) (define compile (current-compile)) @@ -51,12 +60,16 @@ e)) (compile to-compile immediate-eval?))) +(define-runtime-path cov "coverage.rkt") ;; -> Void ;; clear coverage map (define (clear-coverage!) (dict-clear! coverage) (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]) + (namespace-require 'rackunit))) ;; -> [Hashof PathString (Listof (List Boolean srcloc))] ;; returns a hash of file to a list, where the first of the list is if diff --git a/raco.rkt b/raco.rkt index 6d6e265..212782e 100644 --- a/raco.rkt +++ b/raco.rkt @@ -2,11 +2,11 @@ (require raco/command-name "main.rkt" "format.rkt") (module+ main - + (define coverage-dir "coverage") (define coverage? #f) (define output-format "") - + (define files (expand-directories (command-line @@ -14,17 +14,21 @@ #:once-any [("-d" "--directory") d "Specify output directory" (set! coverage-dir d)] [("-c" "--coverage") format - "Specify that coverage should be run and optional what format" - (set! coverage? #t) + "Specify that coverage should be run and optional what format" + (set! coverage? #t) (set! output-format format)] - #:args files + #:args files files))) (printf "testing ~s\n" files) - (apply test-files! files) + (define passed (apply test-files! files)) (when coverage? (printf "COVERAGE!") (case output-format - [("html") (generate-html-coverage (get-test-coverage) coverage-dir)]))) + [("html") (generate-html-coverage (get-test-coverage) coverage-dir)])) + (exit + (case passed + [(#t) 0] + [(#f) 1]))) ;; TODO allow for arbitrary extensions (define extensions '(#rx".rkt$" #rx".ss$"))