Optionally make partial coverage "uncovered"

NEWS.md

@@ -1,5 +1,10 @@
 # covr (development version)
 
+* Support for excluding partially-covered lines in compiled code (@MichaelChirico, #604).
+  Use `options(covr.gcov_exclude_partial_lines = TRUE)` to require every statement on a line be
+  executed before the line is counted a "covered". For example, `if (verbose) Rprintf("hi\n");`
+  would require a test under `verbose=true` in this stricter setting.
+
 * Messages are now displayed using cli instead of crayon (@olivroy, #591).
 
 * covr now uses `testthat::with_mocked_bindings()` for its internal testing (@olivroy, #595).

R/compiled.R

@@ -16,7 +16,7 @@ parse_gcov <- function(file, package_path = "") {
   }
 
   re <- rex::rex(any_spaces,
-    capture(name = "coverage", some_of(digit, "-", "#", "=")),
+    capture(name = "coverage", some_of(digit, "-", "#", "="), maybe("*")),
     ":", any_spaces,
     capture(name = "line", digits),
     ":"
@@ -29,7 +29,14 @@ parse_gcov <- function(file, package_path = "") {
   matches <- na.omit(matches)
 
   # gcov lines which have no coverage
-  matches$coverage[matches$coverage == "#####"] <- 0 # nolint
+  matches$coverage[matches$coverage == "#####"] <- "0" # nolint
+
+  partial_coverage_idx <- endsWith(matches$coverage, "*")
+  if (isTRUE(getOption("covr.gcov_exclude_partial_lines", FALSE))) {
+    matches$coverage[partial_coverage_idx] <- "0"
+  } else {
+    matches$coverage[partial_coverage_idx] <- sub("[*]$", "", matches$coverage[partial_coverage_idx])
+  }
 
   # gcov lines which have parse error, so make untracked
   matches$coverage[matches$coverage == "====="] <- "-"
@@ -49,6 +56,36 @@ parse_gcov <- function(file, package_path = "") {
   line_coverages(source_file, matches, values, functions)
 }
 
+supports_simple_partial_coverage <- function(gcov_path = getOption("covr.gcov_path", "")) {
+  if (!nzchar(gcov_path)) {
+    stop("Please set covr.gcov_path first")
+  }
+  tmp_dir <- tempfile()
+  dir.create(tmp_dir)
+  old_wd <- setwd(tmp_dir)
+  on.exit({
+    setwd(old_wd)
+    unlink(tmp_dir, recursive = TRUE)
+  })
+
+  cat(file = "test.cc", '
+#include <stdio.h>
+
+int main(int argc, char *argv[]) {
+  int verbose = 0;
+  if (argc > 1 && argv[1][0] == \'v\') {
+    verbose = 1;
+  }
+  if (verbose) printf("Verbose mode is ON\\n");
+  printf("Program finished\\n");
+  return 0;
+}
+')
+  system2(r_compiler(), c("-fprofile-arcs", "-ftest-coverage", "test.cc", "-o", "test.o"))
+  system2("./test.o")
+  system2(gcov_path, "test.cc")
+}
+
 # for mocking
 readLines <- NULL
 file.exists <- NULL

R/icc.R

@@ -119,14 +119,18 @@ run_icov <- function(path, quiet = TRUE,
       class = "coverage")
 }
 
-# check if icc is used
-uses_icc <- function() {
+r_compiler <- function() {
   compiler <- tryCatch(
     {
       system2(file.path(R.home("bin"), "R"),
         args = c("--vanilla", "CMD", "config", "CC"),
         stdout = TRUE)
     },
     warning = function(e) NA_character_)
-  isTRUE(any(grepl("\\bicc\\b", compiler)))
+  compiler
+}
+
+# check if icc is used
+uses_icc <- function() {
+  isTRUE(any(grepl("\\bicc\\b", r_compiler())))
 }

tests/testthat/TestCompiled/NAMESPACE

@@ -3,3 +3,4 @@
 useDynLib(TestCompiled,simple_)
 useDynLib(TestCompiled,simple3_)
 useDynLib(TestCompiled,simple4_)
+useDynLib(TestCompiled,simple5_)

tests/testthat/TestCompiled/R/TestCompiled.R

@@ -12,3 +12,7 @@ simple3 <- function(x) {
 simple4 <- function(x) {
   .Call(simple4_, x) # nolint
 }
+
+simple5 <- function(x) {
+  .Call(simple5_, x) # nolint
+}

tests/testthat/TestCompiled/src/simple.cc

@@ -28,3 +28,10 @@ extern "C" SEXP simple_(SEXP x) {
 extern "C" SEXP simple3_(SEXP x) {
   return simple2_<double, REALSXP>(x);
 }
+
+// multi-expression lines allow for partially executed blocks
+extern "C" SEXP simple5_(SEXP x) {
+  if (REAL(x)[0] > 0) return Rf_ScalarLogical(TRUE);
+  if (REAL(x)[0] < 0) return Rf_ScalarLogical(NA_LOGICAL);
+  return Rf_ScalarLogical(FALSE);
+}

tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R

@@ -14,3 +14,9 @@ test_that("compiled function simple4 works", {
   expect_equal(simple4(3L), 1L)
   expect_equal(simple4(-1L), -1L)
 })
+
+test_that("compiled function simple5 works", {
+  # positive, negative values are tested in if() conditions,
+  #   but both evaluate to '0' --> branch code is not executed.
+  expect_false(simple5(0))
+})

tests/testthat/test-Compiled.R

@@ -6,28 +6,25 @@ test_that("Compiled code coverage is reported including code in headers", {
 
   simple_cc <- cov[cov$filename == "src/simple.cc", ]
   expect_equal(simple_cc[simple_cc$first_line == "10", "value"], 4)
-
   expect_equal(simple_cc[simple_cc$first_line == "16", "value"], 3)
-
   expect_equal(simple_cc[simple_cc$first_line == "19", "value"], 0)
-
   expect_equal(simple_cc[simple_cc$first_line == "21", "value"], 1)
-
   expect_equal(simple_cc[simple_cc$first_line == "23", "value"], 4)
+  # partial coverage counts as coverage by default
+  expect_equal(simple_cc[simple_cc$first_line == "34", "value"], 1)
+  expect_equal(simple_cc[simple_cc$first_line == "35", "value"], 1)
+  expect_equal(simple_cc[simple_cc$first_line == "36", "value"], 1)
 
   # This header contains a C++ template, which requires you to run gcov for
   # each object file separately and merge the results together.
   simple_h <- cov[cov$filename == "src/simple-header.h", ]
   expect_equal(simple_h[simple_h$first_line == "12", "value"], 4)
-
   expect_equal(simple_h[simple_h$first_line == "18", "value"], 3)
-
   expect_equal(simple_h[simple_h$first_line == "21", "value"], 0)
-
   expect_equal(simple_h[simple_h$first_line == "23", "value"], 1)
-
   expect_equal(simple_h[simple_h$first_line == "25", "value"], 4)
 
+
   expect_true(all(unique(cov$filename) %in% c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc")))
 })
 
@@ -106,3 +103,16 @@ test_that("tally_coverage includes compiled code", {
     unique(tall$filename),
     c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc"))
 })
+
+test_that("Partial coverage can be optionally excluded", {
+  skip_on_cran()
+  skip_if(is_win_r41())
+  withr::local_options(list(covr.gcov_exclude_partial_lines = TRUE))
+
+  cov <- as.data.frame(package_coverage("TestCompiled", relative_path = TRUE))
+
+  simple_cc <- cov[cov$filename == "src/simple.cc", ]
+  expect_equal(simple_cc[simple_cc$first_line == "34", "value"], 0)
+  expect_equal(simple_cc[simple_cc$first_line == "35", "value"], 0)
+  expect_equal(simple_cc[simple_cc$first_line == "36", "value"], 1)
+})