parse_data: Fix compatibility with R 4.4

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)
 

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)
 }

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
 }

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")
+    )
+  )
+})