1#' Exclusions
2#'
3#' covr supports a couple of different ways of excluding some or all of a file.
4#'
5#' @section Line Exclusions:
6#'
7#' The `line_exclusions` argument to `package_coverage()` can be used
8#' to exclude some or all of a file.  This argument takes a list of filenames
9#' or named ranges to exclude.
10#'
11#' @section Function Exclusions:
12#'
13#' Alternatively `function_exclusions` can be used to exclude R functions
14#' based on regular expression(s). For example `print\\\.*` can be used to
15#' exclude all the print methods defined in a package from coverage.
16#'
17#' @section Exclusion Comments:
18#'
19#' In addition you can exclude lines from the coverage by putting special comments
20#' in your source code. This can be done per line or by specifying a range.
21#' The patterns used can be specified by the `exclude_pattern`, `exclude_start`,
22#' `exclude_end` arguments to `package_coverage()` or by setting the global
23#' options `covr.exclude_pattern`, `covr.exclude_start`, `covr.exclude_end`.
24
25#' @examples
26#' \dontrun{
27#' # exclude whole file of R/test.R
28#' package_coverage(exclusions = "R/test.R")
29#'
30#' # exclude lines 1 to 10 and 15 from R/test.R
31#' package_coverage(line_exclusions = list("R/test.R" = c(1:10, 15)))
32#'
33#' # exclude lines 1 to 10 from R/test.R, all of R/test2.R
34#' package_coverage(line_exclusions = list("R/test.R" = 1:10, "R/test2.R"))
35#'
36#' # exclude all print and format methods from the package.
37#' package_coverage(function_exclusions = c("print\\.", "format\\."))
38#'
39#' # single line exclusions
40#' f1 <- function(x) {
41#'   x + 1 # nocov
42#' }
43#'
44#' # ranged exclusions
45#' f2 <- function(x) { # nocov start
46#'   x + 2
47#' } # nocov end
48#' }
49#' @name exclusions
50NULL
51
52exclude <- function(coverage,
53  line_exclusions = NULL,
54  function_exclusions = NULL,
55  exclude_pattern = getOption("covr.exclude_pattern"),
56  exclude_start = getOption("covr.exclude_start"),
57  exclude_end = getOption("covr.exclude_end"),
58  path = NULL) {
59
60  sources <- traced_files(coverage)
61
62  source_exclusions <- lapply(sources,
63    function(x) {
64      parse_exclusions(x$file_lines, exclude_pattern, exclude_start, exclude_end)
65    })
66
67  excl <- normalize_exclusions(c(source_exclusions, line_exclusions), path)
68
69  df <- as.data.frame(coverage, sort = FALSE)
70
71  to_exclude <- rep(FALSE, length(coverage))
72
73  if (!is.null(function_exclusions)) {
74    to_exclude <- Reduce(`|`, init = to_exclude,
75      Map(rex::re_matches, function_exclusions, MoreArgs = list(data = df$functions)))
76    to_exclude[is.na(to_exclude)] <- FALSE
77  }
78
79  df$full_name <- vcapply(coverage,
80    function(x) {
81      normalize_path(get_source_filename(x$srcref, full.names = TRUE))
82    })
83
84  to_exclude <- to_exclude | vlapply(seq_len(NROW(df)),
85    function(i) {
86      file <- df[i, "full_name"]
87      which_exclusion <- match(file, names(excl))
88
89      !is.na(which_exclusion) &&
90        (
91          identical(excl[[which_exclusion]], Inf) ||
92          all(seq(df[i, "first_line"], df[i, "last_line"]) %in% excl[[file]])
93        )
94    })
95
96  if (any(to_exclude)) {
97    coverage <- coverage[!to_exclude]
98  }
99
100  coverage
101}
102
103parse_exclusions <- function(lines,
104                             exclude_pattern = getOption("covr.exclude"),
105                             exclude_start = getOption("covr.exclude_start"),
106                             exclude_end = getOption("covr.exclude_end")) {
107
108  exclusions <- numeric(0)
109
110  starts <- which(rex::re_matches(lines, exclude_start))
111  ends <- which(rex::re_matches(lines, exclude_end))
112
113  if (length(starts) > 0) {
114    if (length(starts) != length(ends)) {
115      stop(length(starts), " starts but only ", length(ends), " ends!")
116    }
117
118    for (i in seq_along(starts)) {
119      exclusions <- c(exclusions, seq(starts[i], ends[i]))
120    }
121  }
122
123  exclusions <- c(exclusions, which(rex::re_matches(lines, exclude_pattern)))
124
125  sort(unique(exclusions))
126}
127
128file_exclusions <- function(x, path = NULL) {
129  excl <- normalize_exclusions(x, path)
130
131  full_files <- vlapply(excl, function(x1) length(x1) == 1 && x1 == Inf)
132  if (any(full_files)) {
133    names(excl)[full_files]
134  } else {
135    NULL
136  }
137}
138
139normalize_exclusions <- function(x, path = NULL) {
140  if (is.null(x) || length(x) <= 0) {
141    return(list())
142  }
143
144  # no named parameters at all
145  if (is.null(names(x))) {
146    x <- structure(relist(rep(Inf, length(x)), x), names = x)
147  } else {
148    unnamed <- names(x) == ""
149    if (any(unnamed)) {
150
151      # must be character vectors of length 1
152      bad <- vlapply(seq_along(x),
153        function(i) {
154          unnamed[i] & (!is.character(x[[i]]) | length(x[[i]]) != 1)
155        })
156
157      if (any(bad)) {
158        stop("Full file exclusions must be character vectors of length 1. items: ",
159             paste(collapse = ", ", which(bad)),
160             " are not!",
161             call. = FALSE)
162      }
163      names(x)[unnamed] <- x[unnamed]
164      x[unnamed] <- Inf
165    }
166  }
167
168  if (!is.null(path)) {
169    names(x) <- file.path(path, names(x))
170  }
171  names(x) <- normalize_path(names(x))
172
173  remove_line_duplicates(
174    remove_file_duplicates(
175      compact(x)
176    )
177  )
178}
179
180remove_file_duplicates <- function(x) {
181  unique_names <- unique(names(x))
182
183  ## check for duplicate files
184  if (length(unique_names) < length(names(x))) {
185    x <- lapply(unique_names,
186                function(name) {
187                  vals <- unname(unlist(x[names(x) == name]))
188                  if (any(vals == Inf)) {
189                    Inf
190                  } else {
191                    vals
192                  }
193                })
194
195    names(x) <- unique_names
196  }
197
198  x
199}
200
201remove_line_duplicates <- function(x) {
202  x[] <- lapply(x, unique)
203
204  x
205}
206
207parse_covr_ignore <- function(file = getOption("covr.covrignore", Sys.getenv("COVR_COVRIGNORE", ".covrignore"))) {
208  if (!file.exists(file)) {
209    return(NULL)
210  }
211  lines <- readLines(file)
212  paths <- Sys.glob(lines, dirmark = TRUE)
213  files <- unlist(
214    lapply(paths, function(x) {
215      if (dir.exists(x)) {
216        list.files(recursive = TRUE, all.files = TRUE, path = x, full.names = TRUE)
217      } else {
218        x
219      }
220    }))
221}
222