diff --git a/info.rkt b/info.rkt index 56a90fe..4e0331f 100644 --- a/info.rkt +++ b/info.rkt @@ -5,7 +5,7 @@ "syntax-color-lib" "compiler-lib")) (define build-deps '("racket-doc" "scribble-lib" "typed-racket-doc" "htdp-lib" - "net-doc" "scribble-doc")) + "net-doc" "scribble-doc" "at-exp-lib")) (define raco-commands '(("cover" (submod cover/raco main) "a code coverage tool" 30))) diff --git a/private/format-utils.rkt b/private/format-utils.rkt index ad9fec4..8e1ab86 100644 --- a/private/format-utils.rkt +++ b/private/format-utils.rkt @@ -47,11 +47,12 @@ (with-input-from-file f (thunk (define lexer - (with-handlers ([exn:fail:read? (const racket-lexer)]) - (define f (read-language)) - (if f - (f 'color-lexer racket-lexer) - racket-lexer))) + (maybe-wrap-lexer + (with-handlers ([exn:fail:read? (const racket-lexer)]) + (define f (read-language)) + (if f + (f 'color-lexer racket-lexer) + racket-lexer)))) (define irrelevant? (make-irrelevant? lexer f submods)) (define file-length (string-length (file->string f))) (define cache @@ -61,6 +62,12 @@ [else (raw-covered? i c)])))) cache))) +(define (maybe-wrap-lexer f) + (if (procedure-arity-includes? f 3) + f + (lambda (a b c) + (apply values (append (call-with-values (thunk f a) list) (list b c)))))) + ;; Lexer(in the sence of color:text<%>) InputPort (Maybe (Listof Symbol)) -> (Natural -> Boolean) ;; builds a function that determines if a given location in that port is irrelivent. (define (make-irrelevant? lexer f submods) diff --git a/tests/main.rkt b/tests/main.rkt index 1466805..60f686a 100644 --- a/tests/main.rkt +++ b/tests/main.rkt @@ -3,7 +3,8 @@ ;; for every .rkt file in those directories it loads ;; tests that file and checks its coverage against an ;; .rktl file of the same name -(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules) +(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules + make-covered?) "../private/file-utils.rkt" racket/runtime-path rackunit) @@ -27,15 +28,16 @@ (define-values (expected-coverage expected-uncoverage) (with-input-from-file cover (lambda () (values (ranges->numbers (read)) (ranges->numbers (read)))))) + (define covered? (make-covered? program actual-coverage)) (test-begin (for ([i expected-coverage]) - (check-true (covered? i actual-coverage) - (format "expected char ~a to be covered, but it was not, in: ~s" - i program))) + (check-equal? (covered? i) 'covered + (format "expected char ~a to be covered, but it was not, in: ~s" + i program))) (for ([i expected-uncoverage]) - (check-true (not (covered? i actual-coverage)) - (format "expected char ~a to be uncovered, but it was, in: ~s" - i program))))) + (check-equal? (covered? i) 'uncovered + (format "expected char ~a to be uncovered, but it was, in: ~s" + i program))))) (clear-coverage!)) @@ -51,20 +53,8 @@ (ranges->numbers r) (cons a (ranges->numbers (cons (list (add1 a) b) r))))])) -(define (covered? i map) - (for*/and ([l map] - [b (in-value (first l))] - [srcloc (in-value (second l))] - #:when (within? i srcloc)) - b)) - -(define (within? i src) - (match src - [(srcloc _ _ _ start range) - (<= start i (+ start range))])) - (module+ test - (define-runtime-path-list test-dirs '("basic" "simple-multi" "syntax")) + (define-runtime-path-list test-dirs '("basic" "simple-multi" "syntax" "at-exp")) (for-each (compose test-dir path->string) test-dirs) (define-runtime-path submods "submods") (parameterize ([irrelevant-submodules null])