/usr/share/lilypond/2.18.2/scm/coverage.scm is in lilypond-data 2.18.2-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | ;;;; coverage.scm
(define-module (scm coverage))
(use-modules (lily)
(ice-9 rdelim)
(ice-9 regex)
(ice-9 format) ;; needed for ~8@
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (coverage:show-all filter?)
(let*
((keys
(filter filter?
(sort (map car (hash-table->alist coverage-table)) string<? ))))
(newline)
(for-each
(lambda (k)
(format #t "Coverage for file: ~a\n" k)
(display-coverage
k (hash-ref coverage-table k)
(format #f "~a.cov" (basename k))))
keys)))
(define-public (coverage:enable)
(trap-set! memoize-symbol-handler record-coverage)
(trap-enable 'memoize-symbol)
(trap-enable 'traps))
(define-public (coverage:disable)
(trap-set! memoize-symbol-handler #f)
(trap-disable 'memoize-symbol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define coverage-table (make-hash-table 57))
(define (read-lines port)
(string-split (read-delimited "" port) #\newline))
(define (display-coverage file vec out-file)
(let*
((lines (read-lines (open-file file "r")))
(format-str "~8@a: ~5@a:~a\n")
(out (if out-file (open-output-file out-file)
(current-output-port))))
(format out format-str "-" 0 (format #f "Source:~a" file))
(do
((i 0 (1+ i))
(l lines (cdr l)))
((or (null? l) ))
(format out format-str
(cond
((and (< i (vector-length vec)) (vector-ref vec i)) "1")
((and (string-contains file ".ly") (string-match "^[ \t]*%.*$" (car l)))
"-")
((string-match "^[ \t]*[()'`,]*$" (car l))
"-")
((string-match "^[ \t]*;.*$" (car l))
"-")
(else "0"))
(1+ i)
(car l)))))
(define (record-coverage key cont exp env)
(let*
((name (source-property exp 'filename))
(line (source-property exp 'line))
(vec (and name (hash-ref coverage-table name #f)))
(veclen (and vec (vector-length vec)))
(veccopy (lambda (src dst)
(vector-move-left! src 0 (vector-length src)
dst 0)
dst)))
(if (and line name)
(begin
(if (or (not vec) (>= line (vector-length vec)))
(set! vec
(hash-set! coverage-table name
(if vec
(veccopy vec (make-vector (1+ line) #f))
(make-vector (1+ line) #f)))))
(vector-set! vec line #t))
)))
|