3 (define-module (scm coverage))
8 (ice-9 format) ;; needed for ~8@
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13 (define-public (coverage:show-all filter?)
17 (sort (map car (hash-table->alist coverage-table)) string<? ))))
23 (format #t "Coverage for file: ~a\n" k)
25 k (hash-ref coverage-table k)
26 (format #f "~a.cov" (basename k))))
30 (define-public (coverage:enable)
31 (trap-set! memoize-symbol-handler record-coverage)
32 (trap-enable 'memoize-symbol)
36 (define-public (coverage:disable)
37 (trap-set! memoize-symbol-handler #f)
38 (trap-disable 'memoize-symbol))
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42 (define coverage-table (make-hash-table 57))
44 (define (read-lines port)
45 (string-split (read-delimited "" port) #\newline))
47 (define (display-coverage file vec out-file)
49 ((lines (read-lines (open-file file "r")))
50 (format-str "~8@a: ~5@a:~a\n")
51 (out (if out-file (open-output-file out-file)
52 (current-output-port))))
54 (format out format-str "-" 0 (format #f "Source:~a" file))
60 (format out format-str
62 ((and (< i (vector-length vec)) (vector-ref vec i)) "1")
63 ((and (string-contains file ".ly") (string-match "^[ \t]*%.*$" (car l)))
65 ((string-match "^[ \t]*[()'`,]*$" (car l))
67 ((string-match "^[ \t]*;.*$" (car l))
74 (define (record-coverage key cont exp env)
76 ((name (source-property exp 'filename))
77 (line (source-property exp 'line))
78 (vec (and name (hash-ref coverage-table name #f)))
79 (veclen (and vec (vector-length vec)))
80 (veccopy (lambda (src dst)
81 (vector-move-left! src 0 (vector-length src)
86 (if (or (not vec) (>= line (vector-length vec)))
88 (hash-set! coverage-table name
90 (veccopy vec (make-vector (1+ line) #f))
91 (make-vector (1+ line) #f)))))
93 (vector-set! vec line #t))