Hotfix: Fix regression in how test depth is calculated; add exec index (#485)

Author: dgkf

DESCRIPTION

@@ -1,7 +1,7 @@
 Encoding: UTF-8
 Package: covr
 Title: Test Coverage for Packages
-Version: 3.5.1.9002
+Version: 3.5.1.9003
 Authors@R: c(
     person("Jim", "Hester", email = "[email protected]", role = c("aut", "cre")),
     person("Willem", "Ligtenberg", role = "ctb"),

NEWS.md

@@ -2,9 +2,8 @@
 
 * Added `covr.record_tests` option. When `TRUE`, this enables the recording of
   the trace of the tests being executed and adds an itemization of which tests
-  result in the exeuction of each trace. For more details see
-  `?covr.record_tests`
-  `?covr.record_tests` (@dgkf, #463)
+  result in the execution of each trace. For more details see
+  `?covr.record_tests` (@dgkf, #463, #485)
 
 * `package_coverage()` now sets the environment variable `R_TESTS` to the tests-startup.R file like R CMD check does (#420)
 

R/trace_calls.R

@@ -117,8 +117,9 @@ new_counter <- function(src_ref, parent_functions) {
   if (isTRUE(getOption("covr.record_tests", FALSE))) {
     .counters[[key]]$tests <- matrix(
       numeric(0L),
-      ncol = 2,
-      dimnames = list(c(), c("test", "depth")))
+      ncol = 3L,
+      # test index; call stack depth of covr:::count; execution order index
+      dimnames = list(c(), c("test", "depth", "i")))
   }
 
   key

R/trace_tests.R

@@ -18,10 +18,11 @@
 #'     execution.
 #'
 #'   \item `$<srcref>$tests`: For each srcref count in the coverage object, a
-#'     `$tests` field is now included which contains a matrix with two columns,
-#'     "test" and "depth" which specify the test number (corresponding to the
-#'     index of the test in `attr(,"tests")` and the stack depth into the target
-#'     code where the trace was executed.
+#'     `$tests` field is now included which contains a matrix with three columns,
+#'     "test", "depth" and "i" which specify the test number (corresponding to the
+#'     index of the test in `attr(,"tests")`, the stack depth into the target
+#'     code where the trace was executed, and the order of execution for each
+#'     test.
 #' }
 #'
 #' @section Test traces:
@@ -48,28 +49,42 @@
 #' fcode <- '
 #' f <- function(x) {
 #'   if (x)
-#'     TRUE
+#'     f(!x)
 #'   else
 #'     FALSE
 #' }'
 #'
 #' options(covr.record_tests = TRUE)
 #' cov <- code_coverage(fcode, "f(TRUE)")
 #'
-#' # extract executed tests traces
-#' attr(cov, "tests")
-#' # $`/tmp/test.R:1:1:1:7:1:7:1:1`
-#' # $`/tmp/test.R:1:1:1:7:1:7:1:1`[[1]]
+#' # extract executed test code for the first test
+#' tail(attr(cov, "tests")[[1L]], 1L)
+#' # [[1]]
 #' # f(TRUE)
 #'
 #' # extract test itemization per trace
 #' cov[[3]][c("srcref", "tests")]
 #' # $srcref
-#' # TRUE
+#' # f(!x)
 #' #
 #' # $tests
-#' #      test depth
-#' # [1,]    1     1
+#' #      test depth i
+#' # [1,]    1     2 4
+#'
+#' # reconstruct the code path of a test by ordering test traces by [,"i"]
+#' lapply(cov, `[[`, "tests")
+#' # $`source.Ref2326138c55:4:6:4:10:6:10:4:4`
+#' #      test depth i
+#' # [1,]    1     1 2
+#' # 
+#' # $`source.Ref2326138c55:3:8:3:8:8:8:3:3`
+#' #      test depth i
+#' # [1,]    1     1 1
+#' # [2,]    1     2 3
+#' # 
+#' # $`source.Ref2326138c55:6:6:6:10:6:10:6:6`
+#' #      test depth i
+#' # [1,]    1     2 4
 #'
 #' @name covr.record_tests
 NULL
@@ -88,10 +103,11 @@ count_test <- function(key) {
   # ignore if .counter was not created with record_tests (nested coverage calls)
   if (is.null(.counters[[key]]$tests)) return()
 
-  depth_into_pkg <- length(sys.calls()) - .current_test$frame - n_calls_into_covr + 1L
+  depth_into_pkg <- length(sys.calls()) - length(.current_test$frames) - n_calls_into_covr + 1L
+  .current_test$i <- .current_test$i + 1L
   .counters[[key]]$tests <- rbind(
     .counters[[key]]$tests,
-    c(length(.counters$tests), depth_into_pkg)
+    c(length(.counters$tests), depth_into_pkg, .current_test$i)
   )
 }
 
@@ -146,6 +162,7 @@ update_current_test <- function(key) {
 
   # build updated current test data, isolating relevant frames
   .current_test$trace <- syscalls[exec_frames]
+  .current_test$i <- 0L
   .current_test$frames <- exec_frames
   .current_test$last_frame <- exec_frames[[Position(
     has_srcref,

man/covr.record_tests.Rd

@@ -16,8 +16,8 @@ test_that("covr.record_tests causes test traces to be recorded", {
 
 
 test_that("covr.record_tests records test indices and depth for each trace", {
-  expect_equal(ncol(cov_func[[1]]$tests), 2L)
-  expect_equal(colnames(cov_func[[1]]$tests), c("test", "depth"))
+  expect_equal(ncol(cov_func[[1]]$tests), 3L)
+  expect_equal(colnames(cov_func[[1]]$tests), c("test", "depth", "i"))
 })
 
 
@@ -63,11 +63,11 @@ test_that("covr.record_tests: merging coverage objects appends tests", {
     ),
     `a:1:2:3:4:5:6:7:8` = list(
       value = 2L,
-      tests = cbind(test = c(1, 2), depth = c(0, 1))
+      tests = cbind(test = c(1, 2), depth = c(0, 1), i = c(1, 3))
     ),
     `b:1:2:3:4:5:6:7:8` = list(
       value = 2L,
-      tests = cbind(test = c(2), depth = c(0))
+      tests = cbind(test = c(2), depth = c(0), i = c(2))
     )
   )
 
@@ -86,11 +86,11 @@ test_that("covr.record_tests: merging coverage objects appends tests", {
     ),
     `a:1:2:3:4:5:6:7:8` = list(
       value = 2L,
-      tests = cbind(test = c(2), depth = c(0))
+      tests = cbind(test = c(2), depth = c(0), i = c(1))
     ),
     `c:1:2:3:4:5:6:7:8` = list(
       value = 2L,
-      tests = cbind(test = c(2), depth = c(0))
+      tests = cbind(test = c(2), depth = c(0), i = c(2))
     )
   )
 
@@ -121,3 +121,28 @@ test_that("covr.record_tests: merging coverage test objects doesn't break defaul
   expect_silent(cov_merged <- merge_coverage(list(.counter_1, .counter_2)))
   expect_equal(cov_merged$`a:1:2:3:4:5:6:7:8`$value, 4L)
 })
+
+
+test_that("covr.record_tests: test that coverage objects contain expected test data", {
+  fcode <- '
+  f <- function(x) {
+    if (x)
+      f(!x)
+    else
+      FALSE
+  }'
+
+  withr::with_options(c("covr.record_tests" = TRUE), cov <- code_coverage(fcode, "f(TRUE)"))
+
+  # expect 4 covr traces due to test
+  expect_equal(sum(unlist(lapply(cov, function(i) nrow(i[["tests"]])))), 4L)
+
+  # expect that all tests have the same index
+  expect_equal(unique(unlist(lapply(cov, function(i) i[["tests"]][,"test"]))), 1L)
+
+  # expect execution order index to be the same length as the number of traces
+  expect_equal(length(unique(unlist(lapply(cov, function(i) i[["tests"]][,"i"])))), 4L)
+
+  # expect that there are two distinct stack depths (`if (x)` (@1), `TRUE` (@2), `FALSE` (@2))
+  expect_equal(length(unique(unlist(lapply(cov, function(i) i[["tests"]][,"depth"])))), 2L)
+})