* Exposed a proper coverage interface, similar to execution counts
* Generalized `annotate-executed-file' so it can deal with both, also can customize its output * Explain the difference between coverage-counts and execution-counts in doc.txt svn: r4906
This commit is contained in:
Eli Barzilay
parent
91aaeb95f5
commit
cb8acb8fd3
|
|
@ -53,8 +53,8 @@ default. The `instrumenting-enabled' parameter affects only the way
|
|||
that source code is compiled, not the way that exception information
|
||||
is reported.
|
||||
|
||||
> (instrumenting-enabled) - returns #t if error tracing instrumentation is
|
||||
enabled, #f otherwise
|
||||
> (instrumenting-enabled) - returns #t if error tracing
|
||||
instrumentation is enabled, #f otherwise
|
||||
> (instrumenting-enabled on?) - enables/disables error tracing
|
||||
instrumentation
|
||||
|
||||
|
|
@ -162,32 +162,51 @@ Clears accumulated profile results.
|
|||
Coverage
|
||||
--------
|
||||
|
||||
Errortrace can track expression execution that is useful for checking
|
||||
test coverage (i.e., simple expression coverage). Enable coverage
|
||||
checking with the `execute-counts-enabled' boolean parameter (but
|
||||
setting `instrumentation-enabled' to #f also disables execute
|
||||
counting):
|
||||
Errortrace can produce coverage information in two flavors: both count
|
||||
the number of times each expression in the source was used during
|
||||
execution. The first flavor uses a simple approach, where each
|
||||
expression is counted when executed; the second one uses the same
|
||||
annotations that the profiler uses, so only function bodies are
|
||||
counted. To see the difference between the two approaches, try this
|
||||
program:
|
||||
|
||||
> (execute-counts-enabled) - returns #t if execute-counting
|
||||
instrumentation is enabled, #f otherwise
|
||||
> (execute-counts-enabled on?) - enables/disables execute-counting
|
||||
instrumentation
|
||||
(define (foo x) (if x 1 2))
|
||||
(equal? (foo #t) 1)
|
||||
|
||||
> (get-execute-counts) - returns a list of pairs, one for each
|
||||
instrumented expression. The first element of the pair is a syntax
|
||||
object (usually containing source location information) for the
|
||||
original expression, and the second element of the pair is the
|
||||
number of times that the expression has been evaluated. These
|
||||
elements are destructively modified, so to take a snapshot you will
|
||||
need to copy them.
|
||||
The first approach will produce exact results, but it is more
|
||||
expensive; use it when you want to know how covered your code is (when
|
||||
the expected counts are small). The second approach produces coarser
|
||||
results (which, in the above case, will miss the `2' expression), but
|
||||
is less expensive; use it when you want to use the counts for
|
||||
profiling (when the expected counts are large).
|
||||
|
||||
> (annotate-executed-file filename-path) - writes the named file to
|
||||
the current output port, inserting an additional line between each
|
||||
source line to reflect execution counts (as reported by
|
||||
`get-execute-counts'). An expression underlined with "^" has been
|
||||
executed 0 times; an expression underlined with "." has been
|
||||
executed 1 time; and an expression underlined with "," has been
|
||||
executed multiple times.
|
||||
> (coverage-counts-enabled [on?])
|
||||
> (execute-counts-enabled [on?])
|
||||
parameters that determine if the first (exact coverage) or second
|
||||
(profiler-based coverage) are enabled. (Remember that setting
|
||||
`instrumentation-enabled' to #f also disables both)
|
||||
|
||||
> (get-coverage-counts)
|
||||
> (get-execute-counts)
|
||||
returns a list of pairs, one for each instrumented expression. The
|
||||
first element of the pair is a syntax object (usually containing
|
||||
source location information) for the original expression, and the
|
||||
second element of the pair is the number of times that the
|
||||
expression has been evaluated. These elements are destructively
|
||||
modified, so to take a snapshot you will need to copy them.
|
||||
|
||||
> (annotate-covered-file filename-path [display-string])
|
||||
> (annotate-executed-file filename-path [display-string])
|
||||
writes the named file to the current output port, inserting an
|
||||
additional line between each source line to reflect execution counts
|
||||
(as reported by `get-coverage-counts' or `get-execute-counts'). The
|
||||
optional display string is used for the annotation: the first
|
||||
character is used for expressions that were visited 0 times, the
|
||||
second character for 1 time, ..., and the last character for
|
||||
expressions that were visited more times. It can also be #t for a
|
||||
maximal display ("012...9ABC...Z"), #f for a minimal display
|
||||
("#-"). The default for `annotate-covered-file' is #f, and the
|
||||
default for `annotate-executed-file' is "^.,".
|
||||
|
||||
_Re-using errortrace handlers_
|
||||
-----------------------------------
|
||||
|
|
|
|||
|
|
@ -15,11 +15,18 @@
|
|||
(define test-coverage-info (make-hash-table))
|
||||
|
||||
(define (initialize-test-coverage-point key expr)
|
||||
(hash-table-put! test-coverage-info key (list #f expr)))
|
||||
(hash-table-put! test-coverage-info key (cons expr 0)))
|
||||
|
||||
(define (test-covered key)
|
||||
(let ([v (hash-table-get test-coverage-info key)])
|
||||
(set-car! v #t)))
|
||||
(set-cdr! v (add1 (cdr v)))))
|
||||
|
||||
(define (get-coverage-counts)
|
||||
(hash-table-map test-coverage-info (lambda (k v) v)))
|
||||
|
||||
(define (annotate-covered-file name . more)
|
||||
(apply annotate-file name (get-coverage-counts)
|
||||
(if (null? more) '(#f) more)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Profiling run-time support
|
||||
|
|
@ -145,55 +152,81 @@
|
|||
(define (get-execute-counts)
|
||||
(hash-table-map execute-info (lambda (k v) v)))
|
||||
|
||||
(define (annotate-executed-file name)
|
||||
(define (annotate-executed-file name . more)
|
||||
(apply annotate-file name (get-execute-counts)
|
||||
(if (null? more) '("^.,") more)))
|
||||
|
||||
;; shared functionality for annotate-executed-file and annotate-covered-file
|
||||
(define (annotate-file name counts display-string)
|
||||
(let ([name (path->complete-path name (current-directory))])
|
||||
(let ([here (filter (lambda (s)
|
||||
(and (equal? name (syntax-source (car s)))
|
||||
(syntax-position (car s))))
|
||||
(get-execute-counts))])
|
||||
(let ([sorted
|
||||
(sort
|
||||
here
|
||||
(lambda (a b)
|
||||
(let ([ap (syntax-position (car a))]
|
||||
[bp (syntax-position (car b))])
|
||||
(or (< ap bp) ; earlier first
|
||||
(and (= ap bp)
|
||||
(let ([as (syntax-span (car a))]
|
||||
[bs (syntax-span (car b))])
|
||||
(or (> as bs) ; wider first at same pos
|
||||
(and (= as bs)
|
||||
;; less called for same region last
|
||||
(> (cdr a) (cdr b))))))))))]
|
||||
[pic (make-string (file-size name) #\space)])
|
||||
;; fill out picture:
|
||||
(for-each (lambda (s)
|
||||
(let ([pos (sub1 (syntax-position (car s)))]
|
||||
[span (syntax-span (car s))]
|
||||
[key (case (cdr s) [(0) #\^] [(1) #\.] [else #\,])])
|
||||
(let loop ([p pos])
|
||||
(unless (= p (+ pos span))
|
||||
(string-set! pic p key)
|
||||
(loop (add1 p))))))
|
||||
sorted)
|
||||
;; Write annotated file
|
||||
(with-input-from-file name
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ([pos (file-position (current-input-port))]
|
||||
[line (read-line (current-input-port) 'any)])
|
||||
(unless (eof-object? line)
|
||||
(printf "~a~n" line)
|
||||
(let ([w (string-length line)])
|
||||
;; Blank out leading spaces in pic:
|
||||
(let loop ([i 0])
|
||||
(cond
|
||||
[(and (< i w)
|
||||
(char-whitespace? (string-ref line i)))
|
||||
(string-set! pic (+ pos i) (string-ref line i))
|
||||
(loop (add1 i))]))
|
||||
(printf "~a~n" (substring pic pos (+ pos w))))
|
||||
(loop))))))))))
|
||||
(let* (;; Filter relevant syntaxes
|
||||
[here (filter (lambda (s)
|
||||
(and (equal? name (syntax-source (car s)))
|
||||
(syntax-position (car s))))
|
||||
counts)]
|
||||
;; Sort them: earlier first, wider if in same position
|
||||
[sorted (sort here
|
||||
(lambda (a b)
|
||||
(let ([ap (syntax-position (car a))]
|
||||
[bp (syntax-position (car b))])
|
||||
(or (< ap bp)
|
||||
(and (= ap bp)
|
||||
(> (syntax-span (car a))
|
||||
(syntax-span (car b))))))))]
|
||||
;; Merge entries with the same position+span
|
||||
[sorted (if (null? sorted)
|
||||
sorted ; guarantee one element for the next case
|
||||
(let loop ([xs (reverse! sorted)] [r '()])
|
||||
(cond [(null? (cdr xs)) (append xs r)]
|
||||
[(and (= (syntax-position (caar xs))
|
||||
(syntax-position (caadr xs)))
|
||||
(= (syntax-span (caar xs))
|
||||
(syntax-span (caadr xs))))
|
||||
;; doesn't matter which syntax object is kept,
|
||||
;; we only care about its position+span
|
||||
(loop (cons (cons (caar xs)
|
||||
(max (cdar xs) (cdadr xs)))
|
||||
(cddr xs))
|
||||
r)]
|
||||
[else (loop (cdr xs) (cons (car xs) r))])))]
|
||||
[pic (make-string (file-size name) #\space)]
|
||||
[display-string
|
||||
(case display-string
|
||||
[(#t) "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"]
|
||||
[(#f) "#-"]
|
||||
[else display-string])]
|
||||
[many-char (string-ref display-string
|
||||
(sub1 (string-length display-string)))])
|
||||
;; Fill out picture
|
||||
(for-each (lambda (s)
|
||||
(let ([pos (sub1 (syntax-position (car s)))]
|
||||
[span (syntax-span (car s))]
|
||||
[key (let ([k (cdr s)])
|
||||
(if (< k (string-length display-string))
|
||||
(string-ref display-string k)
|
||||
many-char))])
|
||||
(let loop ([p pos])
|
||||
(unless (= p (+ pos span))
|
||||
(string-set! pic p key)
|
||||
(loop (add1 p))))))
|
||||
sorted)
|
||||
;; Write annotated file
|
||||
(with-input-from-file name
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(let ([pos (file-position (current-input-port))]
|
||||
[line (read-line (current-input-port) 'any)])
|
||||
(unless (eof-object? line)
|
||||
(printf "~a\n" line)
|
||||
(let ([w (string-length line)])
|
||||
;; Blank leading spaces in pic (copy them: works for tabs)
|
||||
(let loop ([i 0])
|
||||
(when (and (< i w)
|
||||
(char-whitespace? (string-ref line i)))
|
||||
(string-set! pic (+ pos i) (string-ref line i))
|
||||
(loop (add1 i))))
|
||||
(printf "~a\n" (substring pic pos (+ pos w))))
|
||||
(loop)))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Eval handler, exception handler
|
||||
|
|
@ -350,5 +383,9 @@
|
|||
get-execute-counts
|
||||
annotate-executed-file
|
||||
|
||||
annotate-top))
|
||||
;; use names that are consistent with the above
|
||||
(rename test-coverage-enabled coverage-counts-enabled)
|
||||
get-coverage-counts
|
||||
annotate-covered-file
|
||||
|
||||
annotate-top))
|
||||
|
|
|
|||
|
|
@ -19,7 +19,11 @@
|
|||
|
||||
execute-counts-enabled
|
||||
get-execute-counts
|
||||
annotate-executed-file)
|
||||
annotate-executed-file
|
||||
|
||||
coverage-counts-enabled
|
||||
get-coverage-counts
|
||||
annotate-covered-file)
|
||||
|
||||
(current-compile errortrace-compile-handler)
|
||||
(error-display-handler errortrace-error-display-handler)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user