1 (define-module (scm coverage))
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 (define-public (coverage:show-all)
13 (if (string-contains key "lilypond")
20 (display-coverage key val)))
25 (define-public (coverage:enable)
26 (trap-set! memoize-symbol-handler record-coverage)
27 (trap-enable 'memoize-symbol)
30 (define-public (coverage:disable)
31 (trap-set! memoize-symbol-handler #f)
32 (trap-disable 'memoize-symbol))
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 (define coverage-table (make-hash-table 57))
38 (define (read-lines port)
39 (string-split (read-delimited "" port) #\newline))
41 (define (display-coverage file vec)
43 ((lines (read-lines (open-file file "r"))))
48 ((or (null? l) (>= i (vector-length vec))))
50 (display (format #f "~8a: ~a\n"
51 (if (vector-ref vec i)
55 (define (record-coverage key cont exp env)
57 ((name (source-property exp 'filename))
58 (line (source-property exp 'line))
59 (vec (and name (hashv-ref coverage-table name #f)))
60 (veclen (and vec (vector-length vec)))
61 (veccopy (lambda (src dst)
62 (vector-move-left! src 0 (vector-length src)
67 (if (or (not vec) (>= line (vector-length vec)))
69 (hashv-set! coverage-table name
71 (veccopy vec (make-vector (1+ line) #f))
72 (make-vector (1+ line) #f)))))
74 (vector-set! vec line #t))