1# this does not handle LCOV_EXCL_START ect.
2parse_gcov <- function(file, package_path = "") {
3  if (!file.exists(file)) {
4    return(NULL)
5  }
6
7  lines <- readLines(file)
8  source_file <- rex::re_matches(lines[1], rex::rex("Source:", capture(name = "source", anything)))$source
9
10  # retrieve full path to the source files
11  source_file <- normalize_path(source_file)
12
13  # If the source file does not start with the package path or does not exist ignore it.
14  if (!file.exists(source_file) || !grepl(rex::rex(start, rex::regex(paste0(package_path, collapse = "|"))), source_file)) {
15    return(NULL)
16  }
17
18  re <- rex::rex(any_spaces,
19    capture(name = "coverage", some_of(digit, "-", "#", "=")),
20    ":", any_spaces,
21    capture(name = "line", digits),
22    ":"
23  )
24
25  matches <- rex::re_matches(lines, re)
26
27  # Exclude lines with no match to the pattern
28  lines <- lines[!is.na(matches$coverage)]
29  matches <- na.omit(matches)
30
31  # gcov lines which have no coverage
32  matches$coverage[matches$coverage == "#####"] <- 0 # nolint
33
34  # gcov lines which have parse error, so make untracked
35  matches$coverage[matches$coverage == "====="] <- "-"
36
37  coverage_lines <- matches$line != "0" & matches$coverage != "-"
38  matches <- matches[coverage_lines, ]
39
40  values <- as.numeric(matches$coverage)
41
42  if (any(is.na(values))) {
43    stop("values could not be coerced to numeric ", matches$coverage)
44  }
45
46  # There are no functions for gcov, so we set everything to NA
47  functions <- rep(NA_character_, length(values))
48
49  line_coverages(source_file, matches, values, functions)
50}
51
52clean_gcov <- function(path) {
53  src_dir <- file.path(path, "src")
54
55  gcov_files <- list.files(src_dir,
56                    pattern = rex::rex(or(".gcda", ".gcno", ".gcov"), end),
57                    full.names = TRUE,
58                    recursive = TRUE)
59
60  unlink(gcov_files)
61}
62
63run_gcov <- function(path, quiet = TRUE, clean = TRUE,
64                      gcov_path = getOption("covr.gcov", ""),
65                      gcov_args = getOption("covr.gcov_args", NULL)) {
66  if (!nzchar(gcov_path)) {
67    return()
68  }
69
70  src_path <- normalize_path(file.path(path, "src"))
71  if (!file.exists(src_path)) {
72     return()
73  }
74
75  gcov_inputs <- list.files(path, pattern = rex::rex(".gcno", end), recursive = TRUE, full.names = TRUE)
76  run_gcov_one <- function(src) {
77    system_check(gcov_path,
78      args = c(gcov_args, src, "-p", "-o", dirname(src)),
79      quiet = quiet, echo = !quiet)
80    gcov_outputs <- list.files(path, pattern = rex::rex(".gcov", end), recursive = TRUE, full.names = TRUE)
81    if (clean) {
82      on.exit(unlink(gcov_outputs))
83    }
84    unlist(lapply(gcov_outputs, parse_gcov, package_path = c(path, getOption("covr.gcov_additional_paths", NULL))), recursive = FALSE)
85  }
86
87  withr::with_dir(src_path, {
88    compact(unlist(lapply(gcov_inputs, run_gcov_one), recursive = FALSE))
89  })
90}
91
92line_coverages <- function(source_file, matches, values, functions) {
93
94  # create srcfile reference from the source file
95  src_file <- srcfilecopy(source_file, readLines(source_file))
96
97  line_lengths <- vapply(src_file$lines[as.numeric(matches$line)], nchar, numeric(1))
98
99  res <- Map(function(line, length, value, func) {
100    src_ref <- srcref(src_file, c(line, 1, line, length))
101    res <- list(srcref = src_ref, value = value, functions = func)
102    class(res) <- "line_coverage"
103    res
104  },
105  matches$line, line_lengths, values, functions)
106
107  if (!length(res)) {
108    return(NULL)
109  }
110
111  names(res) <- lapply(res, function(x) key(x$srcref))
112
113  class(res) <- "line_coverages"
114  res
115}
116