blob: 15bdd250e789610ad8352afa1e22763db5b9040c (
plain)
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
;;; Commentary:
;;; A rudamentary parser for the GCOV coverage file format.
;;; Code:
(define-module (hnh util coverage)
:use-module ((hnh util) :select (group-by))
:use-module (hnh util type)
:use-module (hnh util lens)
:use-module (hnh util object)
:use-module (srfi srfi-1)
:use-module (srfi srfi-88)
:use-module (ice-9 match)
:use-module ((ice-9 regex) :select (string-match match:substring))
:export (coverage-info
coverage-info?
filename lines total-lines hit-line
output-coverage
parse-coverage
merge-coverage))
(define-type (coverage-info)
(filename type: string? default: "NO_FILE")
(lines type: (list-of (pair-of integer? integer?))
default: '())
(total-lines type: integer? default: 0)
(hit-lines type: integer? default: 0))
(define* (output-coverage coverage optional: (port (current-output-port)))
(typecheck coverage coverage-info?)
(format port "SF:~a~%" (filename coverage))
(for-each (lambda (line)
(format port "DA:~a,~a~%" (car line) (cdr line)))
(lines coverage))
(format port "LH: ~a~%" (hit-lines coverage))
(format port "LF: ~a~%" (total-lines coverage))
(format port "end_of_record~%"))
;;; Parses a single line from a coverage file
(define (parse-coverage-line line)
(cond ((string-match "^DA:([0-9]+),([0-9]+)$" line)
=> (lambda (m)
(let ((line (string->number (match:substring m 1)))
(hits (string->number (match:substring m 2))))
(list 'DA line hits))))
((string-match "^SF:(.*)$" line)
=> (lambda (m)
(let ((source-file (match:substring m 1)))
(list 'SF source-file))))
((string-match "^LH: ([0-9]+)$" line)
=> (lambda (m)
(let ((hit (string->number (match:substring m 1))))
(list 'LH hit))))
((string-match "LF: ([0-9]+)$" line)
=> (lambda (m)
(let ((lines (string->number (match:substring m 1))))
(list 'LF lines))))
((string-match "^end_of_record$" line)
=> (lambda (m) '(end-of-record)))
(else (scm-error 'no-match "parse-coverage-line"
"Got unknown when parsing coverage data: ~s"
(list line)
#f))))
(define (parse-coverage string)
(cdr
(fold (lambda (line state)
(match (parse-coverage-line line)
(('DA line hits)
(modify state (compose-lenses car* lines)
(lambda (lines) (cons (cons line hits) lines))))
(('SF source)
(set state car* filename source))
(('LH hit)
(set state car* hit-lines hit))
(('LF lines)
(set state car* total-lines lines))
(('end-of-record)
(cons (coverage-info) state))))
(list (coverage-info))
;; First line is simply "TN:", discard it
(remove string-null? (cdr (string-split string #\newline))))))
(define (merge-coverage a b)
(typecheck a coverage-info?)
(typecheck b coverage-info?)
(unless (string=? (filename a) (filename b))
(scm-error 'misc-error "merge-coverage"
"Can only merge coverage data for the same file, got ~s and ~s"
(list (filename a) (filename b))
#f))
#;
(unless (= (total-lines a) (total-lines b))
(scm-error 'misc-error "merge-coverage"
"Mismatch between found lines. Is it really the same file? File: ~s, got ~s and ~s"
(list (filename a) (total-lines a) (total-lines b))
#f))
(define merged-lines
(map (lambda (group)
(cons (car group)
(apply + (map cdr (cdr group)))))
(group-by car (append (lines a) (lines b)))))
(coverage-info
filename: (filename a)
lines: merged-lines
total-lines: (length merged-lines)
hit-lines: (length (remove (compose zero? cdr)
merged-lines))))
|
