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
|
#!@GUILE@ --no-auto-compile
-*- scheme -*-
!#
;;; Gash -- Guile As SHell
;;; Copyright © 2017 Timothy Sample <samplet@ngyro.com>
;;;
;;; The 'coverage-data->lcov' procedure was adapted from:
;;;
;;; GNU Guile
;;; Copyright (C) 2010, 2013, 2018 Free Software Foundation, Inc.
;;;
;;; This file is part of Gash.
;;;
;;; Gash is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Gash is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
(use-modules (ice-9 popen)
(ice-9 receive)
(ice-9 textual-ports)
(srfi srfi-11)
(srfi srfi-26)
(system vm coverage)
(system vm vm))
;; This is a standard Guile function. However, even though it is
;; specified in the manual, it does not support the MODULES
;; keyword. It's only a one-line change, which I've made here.
(define* (coverage-data->lcov data port #:key (modules #f))
;; Output per-file coverage data.
(format port "TN:~%")
(for-each (lambda (file)
(let ((path (search-path %load-path file)))
(if (string? path)
(begin
(format port "SF:~A~%" path)
(for-each (lambda (line+count)
(let ((line (car line+count))
(count (cdr line+count)))
(format port "DA:~A,~A~%"
(+ 1 line) count)))
(line-execution-counts data file))
(let-values (((instr exec)
(instrumented/executed-lines data file)))
(format port "LH: ~A~%" exec)
(format port "LF: ~A~%" instr))
(format port "end_of_record~%"))
(begin
(format (current-error-port)
"skipping unknown source file: ~a~%"
file)))))
(or modules (instrumented-source-files data))))
(define (project-file? file)
"Determine if @var{file} is part of the current project."
(let ((path (search-path %load-path file)))
(string-contains path "@abs_top_srcdir@")))
(define (list-tests)
"List the tests specified in the @file{Makefile}."
(let* ((port (open-pipe* OPEN_READ "make"
"-f" "@abs_top_srcdir@/Makefile" "test-list"))
(tests (filter (lambda (x)
(and (not (string-null? x))
(string-suffix? ".scm" x)))
(string-split (get-string-all port)
char-whitespace?)))
(status (close-pipe port)))
(when (not (eqv? 0 (status:exit-val status)))
(error "Cannot get test list"))
(map (cut string-append "@abs_top_srcdir@/" <>) tests)))
(receive (data result)
(call-with-vm
(lambda ()
(set-vm-engine! 'debug)
(with-code-coverage
(lambda ()
(for-each load (list-tests))))))
(let ((port (open-output-file "lcov.info"))
(modules (filter project-file? (instrumented-source-files data))))
(coverage-data->lcov data port #:modules modules)
(close port)))
|
