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