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

fixed char/byte location issues

Browse Source
This commit is contained in:
Spencer Florence 2014-12-31 12:09:00 -06:00
parent 8b4b5faa9f
commit d6ec4f7969
6 changed files with 100 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
main.rkt
View File

@ -6,6 +6,10 @@
[test-files! (->* () () #:rest path-string? any/c)]
[clear-coverage! (-> any)]
[get-test-coverage (-> coverage/c)]
[covered? (-> exact-positive-integer? file-coverage/c path-string? (or/c 'yes 'no 'missing))]
[make-covered?
(-> file-coverage/c path-string?
(->* (exact-positive-integer?)
(#:byte? boolean?)
(or/c 'yes 'no 'missing)))]
[generate-coveralls-coverage (->* (coverage/c) (path-string?) any)]
[generate-html-coverage (->* (coverage/c) (path-string?) any)]))

5
private/coveralls.rkt
View File

@ -53,13 +53,14 @@
;; CoverallsCoverage = Nat | json-null
;; Coverage PathString -> [Listof CoverallsCoverage]
;; Coverage PathString Covered? -> [Listof CoverallsCoverage]
;; Get the line coverage for the file to generate a coverage report
(define (line-coverage coverage file)
(define covered? (make-covered? (hash-ref coverage file) file))
(define split-src (string-split (file->string file) "\n"))
(define file-coverage (hash-ref coverage file))
(define (process-coverage value rst-of-line)
(case (covered? value file-coverage file)
(case (covered? value)
['yes (if (equal? 'no rst-of-line) rst-of-line 'yes)]
['no 'no]
[else rst-of-line]))

107
private/format-utils.rkt
View File

@ -1,5 +1,5 @@
#lang racket
(provide get-percentages/top get-percentages/file covered?)
(provide get-percentages/top get-percentages/file make-covered?)
(require syntax/modread syntax/parse unstable/sequence syntax-color/racket-lexer)
(module+ test (require rackunit "../cover.rkt" racket/runtime-path))
@ -21,26 +21,26 @@
(define (file-percentages->top get-% coverage)
(define per-file
(for/list ([(f v) coverage])
(call-with-values (thunk (get-% f v)) list)))
(define covered? (make-covered? v f))
(call-with-values (thunk (get-% f covered?)) list)))
(define total (for/sum ([v per-file]) (second v)))
(for/sum ([v per-file])
(* (first v) (/ (second v) total))))
;; PathString FileCoverage -> Percentage
(define (get-percentages/file path coverage)
;; PathString Covered? -> Percentage
(define (get-percentages/file path covered?)
(hash
'expr (first (call-with-values (thunk (expr-percentage path coverage)) list))))
'expr (first (call-with-values (thunk (expr-percentage path covered?)) list))))
;;; percentage generators. each one has the type:
;; FileCoverage -> Real∈[0,1] Natural
;; FilePath Covered? -> Real∈[0,1] Natural
;; there the Real is the percentage covered
;; and the Natural is the number of things of that type in the file
(define (expr-percentage path coverage)
(define (expr-percentage path covered?)
(define (is-covered? e)
;; we don't need to look at the span because the coverage is expression based
(define p (syntax-position e))
(covered? p coverage path))
(covered? p #:byte? #t))
(define e
(with-module-reading-parameterization
@ -71,7 +71,8 @@
(test-begin
(define f (path->string (simplify-path path)))
(test-files! f)
(define-values (result _) (expr-percentage f (hash-ref (get-test-coverage) f)))
(define covered? (make-covered? (hash-ref (get-test-coverage) f) f))
(define-values (result _) (expr-percentage f covered?))
(check-equal? result 1)
(clear-coverage!)))
@ -80,18 +81,22 @@
;;; a Cover is (U 'yes 'no 'missing)
;; [Hashof PathString [Hashof Natural Cover]]
(define file-location-coverage-cache (make-hash))
;; Natural FileCoverage PathString -> Cover
(define (covered? loc c path)
(define file-cache
(let ([v (hash-ref file-location-coverage-cache path #f)])
(if v v (coverage-cache-file! path c))))
(hash-ref file-cache loc))
(define (make-covered? c path)
(define vec
(list->vector (string->list (file->string path))))
(define file/str->byte-offset (make-str->byte-offset vec))
(define file/byte->str-offset (make-byte->str-offset vec))
(define file-location-coverage-cache
(coverage-cache-file path c file/str->byte-offset))
(lambda (loc #:byte? [byte? #f])
(hash-ref file-location-coverage-cache (if (not byte?) loc (- loc (file/byte->str-offset loc)))
(lambda () (error 'covered? "char ~s was not cache for file ~s" loc path)))))
;; Path FileCoverage -> [Hashof Natural Cover]
(define (coverage-cache-file! f c)
;; Path FileCoverage OffsetFunc -> [Hashof Natural Cover]
(define (coverage-cache-file f c raw-offset)
(with-input-from-file f
(thunk
(define lexer
@ -102,10 +107,7 @@
(for/hash ([i (range 1 (add1 file-length))])
(values i
(cond [(irrelevant? i) 'missing]
[else (raw-covered? i c)]))))
(hash-set! file-location-coverage-cache
f
cache)
[else (raw-covered? i c raw-offset)]))))
cache)))
;; TODO should we only ignore test (and main) submodules?
@ -114,15 +116,9 @@
(define-values (for-lex for-str) (dup-input-port (current-input-port)))
(define str (apply vector (string->list (port->string for-str))))
(define init-offset (- (string-length (file->string f))
(vector-length str)))
(vector-length str)))
(define (offset offset)
(let loop ([s 0] [b 0])
(cond [(= (sub1 offset) b)
(- b s)]
[else
(define l (char-utf-8-length (vector-ref str s)))
(loop (add1 s) (+ b l))])))
(define offset (make-str->byte-offset str))
(let loop ()
(define-values (v type _m start end) (lexer for-lex))
@ -136,15 +132,19 @@
(define stx
(with-input-from-file f
(thunk (with-module-reading-parameterization read-syntax))))
(define offset/mod (make-byte->str-offset str))
(let loop ([stx stx] [first? #t])
(define (loop* stx) (loop stx #f))
(syntax-parse stx
#:datum-literals (module module* module+)
[((~or module module* module+) e ...)
#:when (not first?)
(define pos (syntax-position stx))
(when pos
(for ([i (in-range pos (+ pos (syntax-span stx)))])
(define start (syntax-position stx))
(when start
(define end (+ start (syntax-span stx)))
(for ([i (in-range (- start (offset/mod start))
(- end (offset/mod end)))])
(set-add! s i)))]
[(e ...) (for-each loop* (syntax->list #'(e ...)))]
[_else (void)]))
@ -163,10 +163,11 @@
(define r (syntax-span stx))
(<= p i (+ p r)))
(define (raw-covered? loc c)
(define (raw-covered? i c raw-offset)
(define loc (+ (raw-offset i) i))
(define-values (mode _)
(for/fold ([mode 'none] [last-start 0])
([pair c])
([pair (in-list c)])
(match pair
[(list m (srcloc _ _ _ start range))
(if (and (<= start loc (+ start range -1))
@ -179,15 +180,41 @@
[(#f) 'no]
[else 'missing]))
;; use for determining character/byte offsets for a given
;; 1 indexed character location
(define ((make-str->byte-offset str) offset)
(let loop ([s 0] [b 0])
(cond [(or (= (sub1 offset) b)
(>= s (vector-length str)))
(- b s)]
[else
(define l (char-utf-8-length (vector-ref str s)))
(loop (add1 s) (+ b l))])))
;; used for determining character/byte offsets for a given
;; 1 indexed byte locaiton
(define ((make-byte->str-offset str) offset)
(let loop ([s 0] [b 0])
(cond [(or (= (sub1 offset) s)
(>= s (vector-length str)))
(- b s)]
[else
(define l (char-utf-8-length (vector-ref str s)))
(loop (add1 s) (+ b l))])))
(module+ test
(define-runtime-path path2 "../tests/prog.rkt")
(test-begin
(define f (path->string (simplify-path path2)))
(test-files! f)
(define coverage (hash-ref (get-test-coverage) f))
(check-equal? (covered? 14 coverage f) 'missing)
(check-equal? (covered? 17 coverage f) 'missing)
(check-equal? (covered? 28 coverage f) 'missing)
(check-equal? (covered? 35 coverage f) 'yes)
(check-equal? (covered? 50 coverage f) 'no)
(define covered? (make-covered? coverage f))
(check-equal? (covered? 14) 'missing)
(check-equal? (covered? 17) 'missing)
(check-equal? (covered? 28) 'missing)
(check-equal? (covered? 35) 'yes)
(check-equal? (covered? 50) 'no)
(check-equal? (covered? 52) 'missing)
(check-equal? (covered? 53) 'missing)
(check-equal? (covered? 54) 'missing)
(clear-coverage!)))

20
private/html.rkt
View File

@ -58,14 +58,15 @@
;; FileCoverage PathString PathString -> Xexpr
(define (make-html-file coverage path path-to-css)
(define %age (get-percentages/file path coverage))
(define covered? (make-covered? coverage path))
(define %age (get-percentages/file path covered?))
`(html ()
(head ()
(link ([rel "stylesheet"] [type "text/css"] [href ,path-to-css])))
(body ()
,@(%s->xexprs %age)
(div ([class "code"])
,(file->html coverage path)))))
,(file->html path covered?)))))
(define (%s->xexprs %age)
(for/list ([(type %) %age])
@ -76,16 +77,18 @@
(test-begin
(define f (path->string (simplify-path path)))
(test-files! f)
(check-equal? (make-html-file (hash-ref (get-test-coverage) f) f "main.css")
(define cov (hash-ref (get-test-coverage) f))
(define covered? (make-covered? cov f))
(check-equal? (make-html-file cov f "main.css")
`(html ()
(head () (link ([rel "stylesheet"] [type "text/css"] [href "main.css"])))
(body ()
(p () "expr: 100%" (br ()))
(div ([class "code"])
,(file->html (hash-ref (get-test-coverage) f) f)))))
,(file->html f covered?)))))
(clear-coverage!)))
(define (file->html cover path)
(define (file->html path covered?)
(define file (file->string path))
(define-values (lines _)
(for/fold ([ls null] [pos 1])
@ -94,7 +97,7 @@
(for/fold ([r null] [pos pos])
([c line])
(values
(cons (mode-xml (covered? pos cover path)
(cons (mode-xml (covered? pos)
(encode-char c))
r)
(add1 pos))))
@ -136,8 +139,9 @@
(module+ test
(define (test file out)
(test-files! file)
(check-equal? (file->html (hash-ref (get-test-coverage) file)
file)
(define cov (hash-ref (get-test-coverage) file))
(define covered? (make-covered? cov file))
(check-equal? (file->html file covered?)
out)
(clear-coverage!))
(define f (path->string (simplify-path path)))

15
scribblings/api.scrbl
View File

@ -18,14 +18,15 @@ failed. Test coverage information is still collected when test fail.}
@defproc[(clear-coverage!) any]{Clears all coverage information.}
@defproc[(get-coverage-information) coverage/c]{Gets coverage information.}
@defproc[(covered? (loc exact-positive-integer?) (coverage file-coverage/c)
(path path-string?))
(or/c 'yes 'no 'missing)
@defproc[(make-covered? (coverage file-coverage/c) (path path-string?))
(->* (exact-positive-integer?)
(#:byte? boolean?)
(or/c 'yes 'no 'missing))
]{
Given some location in a file, the
coverage information for that file, and the path to that file,
@racket[covered?] returns if that position how that position is
covered. There are three possible results:
Given some location in a file and the
coverage information for that file @racket[make-covered?] returns
a functions that determins if some @racket[1] indexed character or byte location
in that file is covered. There are three possible results:
@itemize[@item{@racket['missing] --- The location is not in the
coverage information, is a comment, or is in a submodule}
@item{@racket['yes] --- The location is not @racket['missing] and is

5
tests/prog.rkt
View File

@ -2,3 +2,8 @@
;; this is a comment
(+ 1 2)
(λ (x) 3)
(module+ test 20)
(λ (x) 3)
(module+ test 20)
(λ (x) 3)
(module+ test 20)