Improve coverage of C++ templates

C++ templates which have instances in separate compilation units would
overwrite each other's output, so only the last one ran would be
included. Instead we now generate the coverage separately for each
compilation unit, then merge the results after the fact.

Fixes #390

NEWS.md

@@ -8,6 +8,10 @@
 
 * Work around issues related to the new curly curly syntax in rlang (#379, #377, rlang#813)
 
+* Compiled code coverage has been improved, in particular C++ templates now
+  contain the merged coverage of all template instances, even if the instances
+  were defined in separate compilation units. (#390)
+
 ## Bugfixes and minor improvements
 
 * `codecov()` now includes support for the flags field (#365)

R/compiled.R

@@ -73,18 +73,17 @@ run_gcov <- function(path, quiet = TRUE,
   }
 
   gcov_inputs <- list.files(path, pattern = rex::rex(".gcno", end), recursive = TRUE, full.names = TRUE)
-  withr::with_dir(src_path, {
-    run_gcov <- function(src) {
-      system_check(gcov_path,
-        args = c(gcov_args, src, "-p", "-o", dirname(src[[1]])),
-        quiet = quiet, echo = !quiet)
-    }
-    tapply(gcov_inputs, dirname(gcov_inputs), run_gcov)
+  run_gcov_one <- function(src) {
+    system_check(gcov_path,
+      args = c(gcov_args, src, "-p", "-o", dirname(src)),
+      quiet = quiet, echo = !quiet)
     gcov_outputs <- list.files(path, pattern = rex::rex(".gcov", end), recursive = TRUE, full.names = TRUE)
-    structure(
-      as.list(unlist(recursive = FALSE,
-        lapply(gcov_outputs, parse_gcov, package_path = path))),
-      class = "coverage")
+    on.exit(unlink(gcov_outputs))
+    unlist(lapply(gcov_outputs, parse_gcov, package_path = path), recursive = FALSE)
+  }
+
+  withr::with_dir(src_path, {
+    compact(unlist(lapply(gcov_inputs, run_gcov_one), recursive = FALSE))
   })
 }
 

R/data_frame.R

@@ -21,9 +21,22 @@ as.data.frame.coverage <- function(x, row.names = NULL, optional = FALSE, sort =
   df <- data.frame(res, stringsAsFactors = FALSE, check.names = FALSE)
 
   if (sort) {
-    df <- df[order(df$filename, df$first_line, df$first_byte), ]
+    # if we are sorting we no longer need to preserve the order of the input and can merge values together
+    df <- merge_values(df)
+
+    df <- df[order(df$filename, df$first_line, df$first_byte, df$last_line, df$last_byte), ]
   }
 
   rownames(df) <- NULL
+
   df
 }
+
+merge_values <- function(x, sentinel = "___NA___") {
+  # We can't use aggregate directly, because it doesn't allow missing values in
+  # grouping variables...
+  x$functions[is.na(x$functions)] <- sentinel
+  res <- aggregate(value ~ ., x, sum)
+  res$functions[res$functions == sentinel] <- NA_character_
+  res
+}

tests/testthat/test-tally_coverage.R

@@ -6,5 +6,5 @@ test_that("tally_coverage includes compiled code", {
 
   expect_equal(
     unique(tall$filename),
-    c("R/TestCompiled.R", "src/simple-header.h", "src/simple.c"))
+    c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc"))
 })