diff --git a/NEWS.md b/NEWS.md index f7bfb25f..491f452f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # covr (development version) +* Fixed a performance regression and an error triggered by a change in R + 4.4.0. (@kyleam, #588) + * Fixed an issue where attempting to generate code coverage on an already-loaded package could fail on Windows. (@kevinushey, #574) diff --git a/R/parse_data.R b/R/parse_data.R index 612200e2..68d30c58 100644 --- a/R/parse_data.R +++ b/R/parse_data.R @@ -122,7 +122,12 @@ package_parse_data <- new.env() get_parse_data <- function(srcfile) { if (length(package_parse_data) == 0) { lines <- getSrcLines(srcfile, 1L, Inf) - res <- lapply(split_on_line_directives(lines), + lines_split <- split_on_line_directives(lines) + if (!length(lines_split)) { + return(NULL) + } + + res <- lapply(lines_split, function(x) getParseData(parse(text = x, keep.source = TRUE), includeText = TRUE)) for (i in seq_along(res)) { package_parse_data[[names(res)[[i]]]] <- res[[i]] @@ -135,7 +140,16 @@ clean_parse_data <- function() { rm(list = ls(package_parse_data), envir = package_parse_data) } -# Needed to work around https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16756 get_tokens <- function(srcref) { - getParseData(srcref) %||% get_parse_data(attr(getSrcref(srcref), "srcfile")) + # Before R 4.4.0, covr's custom get_parse_data is necessary because + # utils::getParseData returns parse data for only the last file in the + # package. That issue (bug#16756) is fixed in R 4.4.0 (r84538). + # + # On R 4.4.0, continue to use get_parse_data because covr's code expects the + # result to be limited to the srcref file. getParseData will return parse data + # for all of the package's files. + get_parse_data(attr(getSrcref(srcref), "srcfile")) %||% + # This covers the non-installed file case where the source file isn't a + # concatenated file with "line N" directives. + getParseData(srcref) } diff --git a/R/utils.R b/R/utils.R index ebb151b2..6d01c23e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -90,9 +90,18 @@ split_on_line_directives <- function(lines) { capture(name = "line_number", digit), spaces, quotes, capture(name = "filename", anything), quotes)) directive_lines <- which(!is.na(matches$line_number)) + if (!length(directive_lines)) { + return(NULL) + } + file_starts <- directive_lines + 1 file_ends <- c(directive_lines[-1] - 1, length(lines)) - res <- mapply(function(start, end) lines[start:end], file_starts, file_ends) + res <- mapply( + function(start, end) lines[start:end], + file_starts, + file_ends, + SIMPLIFY = FALSE + ) names(res) <- na.omit(matches$filename) res } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index f2dc3df5..90dc0a37 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -51,3 +51,55 @@ test_that("per_line removes blank lines and lines with only punctuation (#387)", expect_equal(line_cov[[1]]$coverage, c(NA, 0, 0, 2, NA, 1, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA)) }) + +context("split_on_line_directives") + +test_that("split_on_line_directives returns NULL for input without directive (#588)", { + expect_identical( + split_on_line_directives(NULL), + NULL + ) + expect_identical( + split_on_line_directives(character()), + NULL + ) + expect_identical( + split_on_line_directives("aa"), + NULL + ) + expect_identical( + split_on_line_directives(c("abc", "def")), + NULL + ) +}) + +test_that("split_on_line_directives does not simplify the result (#588)", { + expect_identical( + split_on_line_directives( + c( + '#line 1 "foo.R"', + "abc", + "def" + ) + ), + list( + "foo.R" = c("abc", "def") + ) + ) + expect_identical( + split_on_line_directives( + c( + '#line 1 "foo.R"', + "abc", + "def", + '#line 4 "bar.R"', + "ghi", + "jkl" + ) + ), + list( + "foo.R" = c("abc", "def"), + "bar.R" = c("ghi", "jkl") + ) + ) +})