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

* Exposed a proper coverage interface, similar to execution counts

Browse Source 
* 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 2006-11-21 05:51:38 +00:00
parent 91aaeb95f5
commit cb8acb8fd3
3 changed files with 137 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/errortrace/doc.txt
View File

@ -53,8 +53,8 @@ default. The `instrumenting-enabled' parameter affects only the way
that source code is compiled, not the way that exception information that source code is compiled, not the way that exception information
is reported. is reported.
> (instrumenting-enabled) - returns #t if error tracing instrumentation is > (instrumenting-enabled) - returns #t if error tracing
enabled, #f otherwise instrumentation is enabled, #f otherwise
> (instrumenting-enabled on?) - enables/disables error tracing > (instrumenting-enabled on?) - enables/disables error tracing
instrumentation instrumentation
@ -162,32 +162,51 @@ Clears accumulated profile results.
Coverage Coverage
-------- --------
Errortrace can track expression execution that is useful for checking Errortrace can produce coverage information in two flavors: both count
test coverage (i.e., simple expression coverage). Enable coverage the number of times each expression in the source was used during
checking with the `execute-counts-enabled' boolean parameter (but execution. The first flavor uses a simple approach, where each
setting `instrumentation-enabled' to #f also disables execute expression is counted when executed; the second one uses the same
counting): 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 (define (foo x) (if x 1 2))
instrumentation is enabled, #f otherwise (equal? (foo #t) 1)
> (execute-counts-enabled on?) - enables/disables execute-counting
instrumentation
> (get-execute-counts) - returns a list of pairs, one for each The first approach will produce exact results, but it is more
instrumented expression. The first element of the pair is a syntax expensive; use it when you want to know how covered your code is (when
object (usually containing source location information) for the the expected counts are small). The second approach produces coarser
original expression, and the second element of the pair is the results (which, in the above case, will miss the `2' expression), but
number of times that the expression has been evaluated. These is less expensive; use it when you want to use the counts for
elements are destructively modified, so to take a snapshot you will profiling (when the expected counts are large).
need to copy them.
> (annotate-executed-file filename-path) - writes the named file to > (coverage-counts-enabled [on?])
the current output port, inserting an additional line between each > (execute-counts-enabled [on?])
source line to reflect execution counts (as reported by parameters that determine if the first (exact coverage) or second
`get-execute-counts'). An expression underlined with "^" has been (profiler-based coverage) are enabled. (Remember that setting
executed 0 times; an expression underlined with "." has been `instrumentation-enabled' to #f also disables both)
executed 1 time; and an expression underlined with "," has been
executed multiple times. > (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_ _Re-using errortrace handlers_
----------------------------------- -----------------------------------

139
collects/errortrace/errortrace-lib.ss
View File

@ -15,11 +15,18 @@
(define test-coverage-info (make-hash-table)) (define test-coverage-info (make-hash-table))
(define (initialize-test-coverage-point key expr) (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) (define (test-covered key)
(let ([v (hash-table-get test-coverage-info 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 ;; Profiling run-time support
@ -145,55 +152,81 @@
(define (get-execute-counts) (define (get-execute-counts)
(hash-table-map execute-info (lambda (k v) v))) (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 ([name (path->complete-path name (current-directory))])
(let ([here (filter (lambda (s) (let* (;; Filter relevant syntaxes
(and (equal? name (syntax-source (car s))) [here (filter (lambda (s)
(syntax-position (car s)))) (and (equal? name (syntax-source (car s)))
(get-execute-counts))]) (syntax-position (car s))))
(let ([sorted counts)]
(sort ;; Sort them: earlier first, wider if in same position
here [sorted (sort here
(lambda (a b) (lambda (a b)
(let ([ap (syntax-position (car a))] (let ([ap (syntax-position (car a))]
[bp (syntax-position (car b))]) [bp (syntax-position (car b))])
(or (< ap bp) ; earlier first (or (< ap bp)
(and (= ap bp) (and (= ap bp)
(let ([as (syntax-span (car a))] (> (syntax-span (car a))
[bs (syntax-span (car b))]) (syntax-span (car b))))))))]
(or (> as bs) ; wider first at same pos ;; Merge entries with the same position+span
(and (= as bs) [sorted (if (null? sorted)
;; less called for same region last sorted ; guarantee one element for the next case
(> (cdr a) (cdr b))))))))))] (let loop ([xs (reverse! sorted)] [r '()])
[pic (make-string (file-size name) #\space)]) (cond [(null? (cdr xs)) (append xs r)]
;; fill out picture: [(and (= (syntax-position (caar xs))
(for-each (lambda (s) (syntax-position (caadr xs)))
(let ([pos (sub1 (syntax-position (car s)))] (= (syntax-span (caar xs))
[span (syntax-span (car s))] (syntax-span (caadr xs))))
[key (case (cdr s) [(0) #\^] [(1) #\.] [else #\,])]) ;; doesn't matter which syntax object is kept,
(let loop ([p pos]) ;; we only care about its position+span
(unless (= p (+ pos span)) (loop (cons (cons (caar xs)
(string-set! pic p key) (max (cdar xs) (cdadr xs)))
(loop (add1 p)))))) (cddr xs))
sorted) r)]
;; Write annotated file [else (loop (cdr xs) (cons (car xs) r))])))]
(with-input-from-file name [pic (make-string (file-size name) #\space)]
(lambda () [display-string
(let loop () (case display-string
(let ([pos (file-position (current-input-port))] [(#t) "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"]
[line (read-line (current-input-port) 'any)]) [(#f) "#-"]
(unless (eof-object? line) [else display-string])]
(printf "~a~n" line) [many-char (string-ref display-string
(let ([w (string-length line)]) (sub1 (string-length display-string)))])
;; Blank out leading spaces in pic: ;; Fill out picture
(let loop ([i 0]) (for-each (lambda (s)
(cond (let ([pos (sub1 (syntax-position (car s)))]
[(and (< i w) [span (syntax-span (car s))]
(char-whitespace? (string-ref line i))) [key (let ([k (cdr s)])
(string-set! pic (+ pos i) (string-ref line i)) (if (< k (string-length display-string))
(loop (add1 i))])) (string-ref display-string k)
(printf "~a~n" (substring pic pos (+ pos w)))) many-char))])
(loop)))))))))) (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 ;; Eval handler, exception handler
@ -350,5 +383,9 @@
get-execute-counts get-execute-counts
annotate-executed-file 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))

6
collects/errortrace/errortrace.ss
View File

@ -19,7 +19,11 @@
execute-counts-enabled execute-counts-enabled
get-execute-counts get-execute-counts
annotate-executed-file) annotate-executed-file
coverage-counts-enabled
get-coverage-counts
annotate-covered-file)
(current-compile errortrace-compile-handler) (current-compile errortrace-compile-handler)
(error-display-handler errortrace-error-display-handler) (error-display-handler errortrace-error-display-handler)