From cf551c63ecae4c8b2de591c25a1a66f6418c5737 Mon Sep 17 00:00:00 2001
From: Jim Hester <jimhester@netflix.com>
Date: Tue, 29 Oct 2024 12:31:28 -0400
Subject: [PATCH 01/25] Initial work on S7 support for covr

---
 R/S7.R                                        | 28 +++++++++++++++
 R/covr.R                                      |  1 +
 src/reassign.c                                |  3 +-
 tests/testthat/TestS7/DESCRIPTION             | 17 ++++++++++
 tests/testthat/TestS7/NAMESPACE               |  3 ++
 tests/testthat/TestS7/R/foo.R                 | 34 +++++++++++++++++++
 tests/testthat/TestS7/tests/testthat.R        | 12 +++++++
 .../testthat/TestS7/tests/testthat/test-foo.R | 18 ++++++++++
 tests/testthat/test-S7.R                      |  5 +++
 9 files changed, 119 insertions(+), 2 deletions(-)
 create mode 100644 R/S7.R
 create mode 100644 tests/testthat/TestS7/DESCRIPTION
 create mode 100644 tests/testthat/TestS7/NAMESPACE
 create mode 100644 tests/testthat/TestS7/R/foo.R
 create mode 100644 tests/testthat/TestS7/tests/testthat.R
 create mode 100644 tests/testthat/TestS7/tests/testthat/test-foo.R
 create mode 100644 tests/testthat/test-S7.R

diff --git a/R/S7.R b/R/S7.R
new file mode 100644
index 00000000..bb1c6509
--- /dev/null
+++ b/R/S7.R
@@ -0,0 +1,28 @@
+replacements_S7 <- function(env) {
+  unlist(recursive = FALSE, use.names = FALSE, eapply(env, all.names = TRUE,
+    function(obj) {
+      if (inherits(obj, "S7_generic")) {
+        traverse_S7_generic(obj)
+      } else if (inherits(obj, "S7_class")) {
+        traverse_S7_class(obj)
+      }
+    }))
+}
+
+traverse_S7_generic <- function(x) {
+	 lapply(names(x@methods), replacement, env = x@methods)
+}
+
+traverse_S7_class <- function(x) {
+  c(use.names=FALSE,
+    list(
+      replacement("constructor", env = x, target_value=x@constructor),
+      replacement("validator", env = x, target_value=x@validator)
+    ),
+    for (prop_fun in c("getter", "setter", "validator")) {
+      lapply(x@properties, function(p) {
+        if (!is.null(p[[prop_fun]])) { replacement(prop_fun, env=p, target_value=p[[prop_fun]]) }
+      })
+    }
+  )
+}
\ No newline at end of file
diff --git a/R/covr.R b/R/covr.R
index 7510db65..6117ad9b 100644
--- a/R/covr.R
+++ b/R/covr.R
@@ -93,6 +93,7 @@ trace_environment <- function(env) {
       replacements_S4(env),
       replacements_RC(env),
       replacements_R6(env),
+      replacements_S7(env),
       replacements_box(env),
       lapply(ls(env, all.names = TRUE), replacement, env = env)))
 
diff --git a/src/reassign.c b/src/reassign.c
index db01f307..6997ecfc 100644
--- a/src/reassign.c
+++ b/src/reassign.c
@@ -5,9 +5,8 @@
 #include <Rdefines.h>
 #include <stdlib.h>  // for NULL
 
-SEXP covr_reassign_function(SEXP name, SEXP env, SEXP old_fun, SEXP new_fun) {
+SEXP covr_reassign_function(SEXP name, SEXP /* unused */ env, SEXP old_fun, SEXP new_fun) {
   if (TYPEOF(name) != SYMSXP) error("name must be a symbol");
-  if (TYPEOF(env) != ENVSXP) error("env must be an environment");
   if (TYPEOF(old_fun) != CLOSXP) error("old_fun must be a function");
   if (TYPEOF(new_fun) != CLOSXP) error("new_fun must be a function");
 
diff --git a/tests/testthat/TestS7/DESCRIPTION b/tests/testthat/TestS7/DESCRIPTION
new file mode 100644
index 00000000..ae47f8ae
--- /dev/null
+++ b/tests/testthat/TestS7/DESCRIPTION
@@ -0,0 +1,17 @@
+Package: tests7
+Title: What the Package Does (One Line, Title Case)
+Version: 0.0.0.9000
+Authors@R: c(
+    person("Jim", "Hester", , "james.f.hester@gmail.com", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0002-2739-7082")),
+    person("RStudio", role = c("cph", "fnd"))
+  )
+Description: What the package does (one paragraph).
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.1
+Imports: S7
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3
diff --git a/tests/testthat/TestS7/NAMESPACE b/tests/testthat/TestS7/NAMESPACE
new file mode 100644
index 00000000..587cf7fc
--- /dev/null
+++ b/tests/testthat/TestS7/NAMESPACE
@@ -0,0 +1,3 @@
+# Generated by roxygen2: do not edit by hand
+
+import(S7)
diff --git a/tests/testthat/TestS7/R/foo.R b/tests/testthat/TestS7/R/foo.R
new file mode 100644
index 00000000..0603c2c2
--- /dev/null
+++ b/tests/testthat/TestS7/R/foo.R
@@ -0,0 +1,34 @@
+#' @import S7
+range <- new_class("range",
+  properties = list(
+    start = class_double,
+    end = class_double,
+    length = new_property(
+      class = class_double,
+      getter = function(self) self@end - self@start,
+      setter = function(self, value) {
+        self@end <- self@start + value
+        self
+      }
+    )
+  ),
+  constructor = function(x) {
+    new_object(S7_object(), start = as.double(min(x, na.rm = TRUE)), end = as.double(max(x, na.rm = TRUE)))
+  },
+  validator = function(self) {
+    if (length(self@start) != 1) {
+      "@start must be length 1"
+    } else if (length(self@end) != 1) {
+      "@end must be length 1"
+    } else if (self@end < self@start) {
+      "@end must be greater than or equal to @start"
+    }
+  }
+)
+
+#' @export
+inside <- new_generic("inside", "x")
+
+method(inside, range) <- function(x, y) {
+  y >= x@start & y <= x@end
+}
diff --git a/tests/testthat/TestS7/tests/testthat.R b/tests/testthat/TestS7/tests/testthat.R
new file mode 100644
index 00000000..df23a12d
--- /dev/null
+++ b/tests/testthat/TestS7/tests/testthat.R
@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(tests7)
+
+test_check("tests7")
diff --git a/tests/testthat/TestS7/tests/testthat/test-foo.R b/tests/testthat/TestS7/tests/testthat/test-foo.R
new file mode 100644
index 00000000..987115e5
--- /dev/null
+++ b/tests/testthat/TestS7/tests/testthat/test-foo.R
@@ -0,0 +1,18 @@
+test_that("range works", {
+  x <- range(1:10)
+
+  x@end <- 20
+
+  expect_error(x@end <- "x", "must be <double>")
+
+  expect_error(x@end <- -1, "greater than or equal")
+
+  expect_equal(inside(x, c(0, 5, 10, 15)), c(FALSE, TRUE, TRUE, TRUE))
+
+  x@length <- 5
+
+  expect_equal(x@length, 5)
+  expect_equal(x@end, 6)
+})
+
+
diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
new file mode 100644
index 00000000..92b97134
--- /dev/null
+++ b/tests/testthat/test-S7.R
@@ -0,0 +1,5 @@
+test_that("S7 coverage is reported", {
+  cov <- as.data.frame(package_coverage("TestS7"))
+ 
+  expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
+})

From 682b17c395e363bfde6be9bbf835fff8c1924850 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 11:53:32 -0500
Subject: [PATCH 02/25] fix prop replacements in `traverse_S7_class`

---
 R/S7.R | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/R/S7.R b/R/S7.R
index bb1c6509..068a38f4 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -14,15 +14,21 @@ traverse_S7_generic <- function(x) {
 }
 
 traverse_S7_class <- function(x) {
-  c(use.names=FALSE,
+  prop_fun_replacements <-
+    lapply(x@properties, function(p) {
+      lapply(c("getter", "setter", "validator"), function(prop_fun) {
+        if (!is.null(p[[prop_fun]])) {
+          replacement(prop_fun, env = p, target_value = p[[prop_fun]])
+        }
+      })
+  })
+  prop_fun_replacements <- unlist(prop_fun_replacements, FALSE, FALSE)
+
+  c(
     list(
       replacement("constructor", env = x, target_value=x@constructor),
       replacement("validator", env = x, target_value=x@validator)
     ),
-    for (prop_fun in c("getter", "setter", "validator")) {
-      lapply(x@properties, function(p) {
-        if (!is.null(p[[prop_fun]])) { replacement(prop_fun, env=p, target_value=p[[prop_fun]]) }
-      })
-    }
+    prop_fun_replacements
   )
 }
\ No newline at end of file

From 5d69e0e21e77c4e954669d96e3995f4da958dcde Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 11:53:53 -0500
Subject: [PATCH 03/25] handle multi-dispatch generics in
 `traverse_S7_generic()`

---
 R/S7.R | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/R/S7.R b/R/S7.R
index 068a38f4..aaf109b2 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -10,7 +10,21 @@ replacements_S7 <- function(env) {
 }
 
 traverse_S7_generic <- function(x) {
-	 lapply(names(x@methods), replacement, env = x@methods)
+  # Each binding in the environment at x@methods is either a function or, for
+  # generics that dispatch on multiple arguments, another environment.
+  get_replacements <- function(env) {
+    replacements <- lapply(names(env), function(name) {
+      target_value <- get(name, envir = env)
+      if (is.environment(target_value)) {
+        # Recurse for nested environments
+        get_replacements(target_value)
+      } else {
+        list(replacement(name, env, target_value))
+      }
+    })
+    unlist(replacements, FALSE, FALSE)
+  }
+  get_replacements(x@methods)
 }
 
 traverse_S7_class <- function(x) {

From 659804d25646308f7176e9a41242ea5bf64502c9 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 11:55:13 -0500
Subject: [PATCH 04/25] add missing `test_path()` in tests

---
 tests/testthat/test-S7.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index 92b97134..fb096857 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
-  cov <- as.data.frame(package_coverage("TestS7"))
- 
+  cov <- as.data.frame(package_coverage(test_path("TestS7")))
+
   expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
 })

From 8058180326b9bb71b003ac2175d56b8d9c14bdb4 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 11:56:08 -0500
Subject: [PATCH 05/25] update expected validator run counts in tests: 3 -> 4

---
 tests/testthat/test-S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index fb096857..0ba7a8b5 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
   cov <- as.data.frame(package_coverage(test_path("TestS7")))
 
-  expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
+  expect_equal(cov$value, c(1, 1, 1, 1, 4, 0, 4, 0, 4, 1, 1))
 })

From 712211c456b01f39287c591238ba5af4720af823 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 11:58:08 -0500
Subject: [PATCH 06/25] CamelCase S7 class name

---
 tests/testthat/TestS7/R/foo.R                   | 4 ++--
 tests/testthat/TestS7/tests/testthat/test-foo.R | 6 ++----
 2 files changed, 4 insertions(+), 6 deletions(-)

diff --git a/tests/testthat/TestS7/R/foo.R b/tests/testthat/TestS7/R/foo.R
index 0603c2c2..786934db 100644
--- a/tests/testthat/TestS7/R/foo.R
+++ b/tests/testthat/TestS7/R/foo.R
@@ -1,5 +1,5 @@
 #' @import S7
-range <- new_class("range",
+Range <- new_class("Range",
   properties = list(
     start = class_double,
     end = class_double,
@@ -29,6 +29,6 @@ range <- new_class("range",
 #' @export
 inside <- new_generic("inside", "x")
 
-method(inside, range) <- function(x, y) {
+method(inside, Range) <- function(x, y) {
   y >= x@start & y <= x@end
 }
diff --git a/tests/testthat/TestS7/tests/testthat/test-foo.R b/tests/testthat/TestS7/tests/testthat/test-foo.R
index 987115e5..0af07179 100644
--- a/tests/testthat/TestS7/tests/testthat/test-foo.R
+++ b/tests/testthat/TestS7/tests/testthat/test-foo.R
@@ -1,5 +1,5 @@
-test_that("range works", {
-  x <- range(1:10)
+test_that("Range works", {
+  x <- Range(1:10)
 
   x@end <- 20
 
@@ -14,5 +14,3 @@ test_that("range works", {
   expect_equal(x@length, 5)
   expect_equal(x@end, 6)
 })
-
-

From 1599df7cd73b984d35e539d1392425528516ae17 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 12:26:47 -0500
Subject: [PATCH 07/25] Fix package-name / dir-name mismatch

---
 tests/testthat/TestS7/DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/TestS7/DESCRIPTION b/tests/testthat/TestS7/DESCRIPTION
index ae47f8ae..5d220743 100644
--- a/tests/testthat/TestS7/DESCRIPTION
+++ b/tests/testthat/TestS7/DESCRIPTION
@@ -1,4 +1,4 @@
-Package: tests7
+Package: TestS7
 Title: What the Package Does (One Line, Title Case)
 Version: 0.0.0.9000
 Authors@R: c(

From 8687ed4e771cfd795d77abd23eac1a2542f45411 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 12:32:25 -0500
Subject: [PATCH 08/25] revert `test_path()` usage

---
 tests/testthat/test-S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index 0ba7a8b5..45af3fa7 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
-  cov <- as.data.frame(package_coverage(test_path("TestS7")))
+  cov <- as.data.frame(package_coverage("TestS7"))
 
   expect_equal(cov$value, c(1, 1, 1, 1, 4, 0, 4, 0, 4, 1, 1))
 })

From 517a018a0f2c51b83e1f1d2b3a40130d8e157bd1 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 12:44:05 -0500
Subject: [PATCH 09/25] one more test pkgname fix

---
 tests/testthat/TestS7/tests/testthat.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/TestS7/tests/testthat.R b/tests/testthat/TestS7/tests/testthat.R
index df23a12d..e4a3e859 100644
--- a/tests/testthat/TestS7/tests/testthat.R
+++ b/tests/testthat/TestS7/tests/testthat.R
@@ -7,6 +7,6 @@
 # * https://testthat.r-lib.org/articles/special-files.html
 
 library(testthat)
-library(tests7)
+library(TestS7)
 
-test_check("tests7")
+test_check("TestS7")

From a29b60bd7711bda330e111b1f653acb2200c7286 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 7 Nov 2024 12:03:25 -0600
Subject: [PATCH 10/25] Make `package_coverage(quiet = TRUE)` truely quiet

---
 R/covr.R | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/R/covr.R b/R/covr.R
index 7510db65..0755d7db 100644
--- a/R/covr.R
+++ b/R/covr.R
@@ -458,7 +458,12 @@ package_coverage <- function(path = ".",
 
       name <- if (.Platform$OS.type == "windows") "R.exe" else "R"
       path <- file.path(R.home("bin"), name)
-      system2(path, args)
+      system2(
+        path,
+        args,
+        stdout = if (quiet) NULL else "",
+        stderr = if (quiet) NULL else ""
+      )
     })
   )
 

From e7c7e8903dd2c6fb98adf8c81930abe67c4ec09d Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 7 Nov 2024 12:09:19 -0600
Subject: [PATCH 11/25] use_testthat(3)

---
 DESCRIPTION                                   |  3 ++-
 tests/testthat.R                              | 20 +++++++++----------
 .../tests/testthat/test-TestCompiled.R        |  1 -
 .../tests/testthat/test-TestCompiled.R        |  1 -
 tests/testthat/test-Compiled.R                |  1 -
 tests/testthat/test-R6.R                      |  2 --
 tests/testthat/test-RC.R                      |  1 -
 tests/testthat/test-S4.R                      |  1 -
 tests/testthat/test-box-R6.R                  |  2 --
 tests/testthat/test-box.R                     |  2 --
 .../test-box_attached_modules_functions-R6.R  |  2 --
 .../test-box_attached_modules_functions.R     |  2 --
 tests/testthat/test-braceless.R               |  2 --
 tests/testthat/test-cobertura.R               |  2 --
 tests/testthat/test-codecov.R                 |  1 -
 tests/testthat/test-corner-cases.R            |  2 --
 tests/testthat/test-coveralls.R               |  2 --
 tests/testthat/test-covr.R                    |  3 ---
 tests/testthat/test-exclusions.R              |  4 ----
 tests/testthat/test-file_coverage.R           |  1 -
 tests/testthat/test-functions.R               |  1 -
 tests/testthat/test-gcov.R                    |  1 -
 tests/testthat/test-gitlab.R                  |  2 --
 tests/testthat/test-memoised.R                |  1 -
 tests/testthat/test-null.R                    |  2 --
 tests/testthat/test-package_coverage.R        |  1 -
 tests/testthat/test-parallel.R                |  3 ---
 tests/testthat/test-print.R                   |  1 -
 tests/testthat/test-record_tests.R            |  2 --
 tests/testthat/test-report.R                  |  2 --
 tests/testthat/test-sonarqube.R               |  2 --
 tests/testthat/test-summary.R                 |  2 --
 tests/testthat/test-trace_calls.R             |  1 -
 tests/testthat/test-utils.R                   |  4 ----
 tests/testthat/test-vectorized.R              |  1 -
 35 files changed, 12 insertions(+), 69 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 35845bed..f87349df 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -61,7 +61,7 @@ Suggests:
     rmarkdown,
     htmltools,
     DT (>= 0.2),
-    testthat,
+    testthat (>= 3.0.0),
     rlang,
     rstudioapi (>= 0.2),
     xml2 (>= 1.0.0),
@@ -74,3 +74,4 @@ License: MIT + file LICENSE
 VignetteBuilder: knitr
 RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
+Config/testthat/edition: 3
diff --git a/tests/testthat.R b/tests/testthat.R
index 82a14ead..d6da5a81 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,12 +1,12 @@
-ops <- options("crayon.enabled" = FALSE, warn = 1)
-library(testthat)
-library("covr")
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
 
-# Skip tests on Solaris as gcc is not in the PATH and I do not have an easy way
-# to mimic the CRAN build environment
-if (!tolower(Sys.info()[["sysname"]]) == "sunos") {
-  Sys.setenv("R_TESTS" = "")
-  test_check("covr")
-}
+library(testthat)
+library(covr)
 
-options(ops)
+test_check("covr")
diff --git a/tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R b/tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R
index 02c5aa7a..97af0b62 100644
--- a/tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R
+++ b/tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R
@@ -1,4 +1,3 @@
-context("Test")
 test_that("compiled function simple works", {
   expect_equal(simple(1), 1)
   expect_equal(simple(2), 1)
diff --git a/tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R b/tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R
index 52d468e1..22a098fc 100644
--- a/tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R
+++ b/tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R
@@ -1,4 +1,3 @@
-context("Test")
 test_that("compiled function simple works", {
   expect_equal(simple(1), 1)
   expect_equal(simple(2), 1)
diff --git a/tests/testthat/test-Compiled.R b/tests/testthat/test-Compiled.R
index a9c3defc..51689de3 100644
--- a/tests/testthat/test-Compiled.R
+++ b/tests/testthat/test-Compiled.R
@@ -1,4 +1,3 @@
-context("Compiled")
 test_that("Compiled code coverage is reported including code in headers", {
   skip_on_cran()
   skip_if(is_win_r41())
diff --git a/tests/testthat/test-R6.R b/tests/testthat/test-R6.R
index 7cce3df8..fee5192d 100644
--- a/tests/testthat/test-R6.R
+++ b/tests/testthat/test-R6.R
@@ -1,5 +1,3 @@
-context("R6")
-
 test_that("R6 methods coverage is reported", {
   # There is some sort of bug that causes this test to fail during R CMD check
   # in R-devel, not sure why, and can't reproduce it interactively
diff --git a/tests/testthat/test-RC.R b/tests/testthat/test-RC.R
index abfe7194..9e66c99d 100644
--- a/tests/testthat/test-RC.R
+++ b/tests/testthat/test-RC.R
@@ -1,4 +1,3 @@
-context("RC")
 test_that("RC methods coverage is reported", {
   cov <- as.data.frame(package_coverage("TestRC"))
 
diff --git a/tests/testthat/test-S4.R b/tests/testthat/test-S4.R
index e019ab7f..44a35f28 100644
--- a/tests/testthat/test-S4.R
+++ b/tests/testthat/test-S4.R
@@ -1,4 +1,3 @@
-context("S4")
 test_that("S4 methods coverage is reported", {
   cov <- as.data.frame(package_coverage("TestS4"))
 
diff --git a/tests/testthat/test-box-R6.R b/tests/testthat/test-box-R6.R
index b50b8408..7eebc1c2 100644
--- a/tests/testthat/test-box-R6.R
+++ b/tests/testthat/test-box-R6.R
@@ -1,5 +1,3 @@
-context("box-R6")
-
 loaded_mods <- loadNamespace("box")$loaded_mods
 rm(list = ls(loaded_mods), envir = loaded_mods)
 
diff --git a/tests/testthat/test-box.R b/tests/testthat/test-box.R
index 9ee174a0..6f3c7a84 100644
--- a/tests/testthat/test-box.R
+++ b/tests/testthat/test-box.R
@@ -1,5 +1,3 @@
-context("box")
-
 loaded_mods <- loadNamespace("box")$loaded_mods
 rm(list = ls(loaded_mods), envir = loaded_mods)
 
diff --git a/tests/testthat/test-box_attached_modules_functions-R6.R b/tests/testthat/test-box_attached_modules_functions-R6.R
index ba491dc8..96087cfa 100644
--- a/tests/testthat/test-box_attached_modules_functions-R6.R
+++ b/tests/testthat/test-box_attached_modules_functions-R6.R
@@ -1,5 +1,3 @@
-context("box-attached-modules-functions-R6")
-
 loaded_mods <- loadNamespace("box")$loaded_mods
 rm(list = ls(loaded_mods), envir = loaded_mods)
 
diff --git a/tests/testthat/test-box_attached_modules_functions.R b/tests/testthat/test-box_attached_modules_functions.R
index 06064083..a9970e79 100644
--- a/tests/testthat/test-box_attached_modules_functions.R
+++ b/tests/testthat/test-box_attached_modules_functions.R
@@ -1,5 +1,3 @@
-context("box-attached-modules-functions")
-
 loaded_mods <- loadNamespace("box")$loaded_mods
 rm(list = ls(loaded_mods), envir = loaded_mods)
 
diff --git a/tests/testthat/test-braceless.R b/tests/testthat/test-braceless.R
index a696c24f..da4edfbe 100644
--- a/tests/testthat/test-braceless.R
+++ b/tests/testthat/test-braceless.R
@@ -1,5 +1,3 @@
-context("braceless")
-
 test_that("if", {
   f <-
 'f <- function(x) {
diff --git a/tests/testthat/test-cobertura.R b/tests/testthat/test-cobertura.R
index 0a214656..603c8722 100644
--- a/tests/testthat/test-cobertura.R
+++ b/tests/testthat/test-cobertura.R
@@ -1,5 +1,3 @@
-context("cobertura_export")
-
 test_that("it works with coverage objects", {
   tmp <- tempfile()
   cov <- package_coverage(test_path("TestSummary"))
diff --git a/tests/testthat/test-codecov.R b/tests/testthat/test-codecov.R
index 9b7493cc..45317142 100644
--- a/tests/testthat/test-codecov.R
+++ b/tests/testthat/test-codecov.R
@@ -1,4 +1,3 @@
-context("codecov")
 ci_vars <- c(
   "APPVEYOR" = NA,
   "APPVEYOR_ACCOUNT_NAME" = NA,
diff --git a/tests/testthat/test-corner-cases.R b/tests/testthat/test-corner-cases.R
index 612ae003..b3a4f1af 100644
--- a/tests/testthat/test-corner-cases.R
+++ b/tests/testthat/test-corner-cases.R
@@ -1,5 +1,3 @@
-context("corner-cases")
-
 test_that("corner-cases are handled as expected", {
   expect_warning(withr::with_output_sink(tempfile(), {
     cov <- file_coverage("corner-cases.R", "corner-cases-test.R")
diff --git a/tests/testthat/test-coveralls.R b/tests/testthat/test-coveralls.R
index cafae047..fd6dd0a1 100644
--- a/tests/testthat/test-coveralls.R
+++ b/tests/testthat/test-coveralls.R
@@ -1,5 +1,3 @@
-context("coveralls")
-
 ci_vars <- c(
   "APPVEYOR" = NA,
   "APPVEYOR_BUILD_NUMBER" = NA,
diff --git a/tests/testthat/test-covr.R b/tests/testthat/test-covr.R
index 413a9358..cdef7781 100644
--- a/tests/testthat/test-covr.R
+++ b/tests/testthat/test-covr.R
@@ -1,4 +1,3 @@
-context("function_coverage")
 test_that("function_coverage", {
 
   withr::with_options(c(keep.source = TRUE), {
@@ -59,7 +58,6 @@ test_that("duplicated first_line", {
   })
 })
 
-context("trace_calls")
 test_that("trace calls handles all possibilities", {
   expr <- expression(y <- x * 10)
 
@@ -68,7 +66,6 @@ test_that("trace calls handles all possibilities", {
   expect_equal(trace_calls(list(expr)), list(expr))
 })
 
-context("show_failures")
 test_that("show_failures shows as much text as it can from the end", {
   withr::with_options(c(warning.length = 300), {
     td <- tempfile()
diff --git a/tests/testthat/test-exclusions.R b/tests/testthat/test-exclusions.R
index 54a93381..b8a1daae 100644
--- a/tests/testthat/test-exclusions.R
+++ b/tests/testthat/test-exclusions.R
@@ -2,7 +2,6 @@ exclude_ops <- list(exclude_pattern = "#TeSt_NoLiNt",
                     exclude_start = "#TeSt_NoLiNt_StArT",
                     exclude_end = "#TeSt_NoLiNt_EnD")
 
-context("parse_exclusions")
 test_that("it returns an empty vector if there are no exclusions", {
   t1 <- c("this",
           "is",
@@ -64,7 +63,6 @@ test_that("it throws an error if start and end are unpaired", {
   expect_error(do.call(parse_exclusions, c(list(t1), exclude_ops)), "but only")
 })
 
-context("normalize_exclusions")
 expect_equal_vals <- function(x, y) {
   testthat::expect_equal(unname(x), unname(y))
 }
@@ -124,7 +122,6 @@ test_that("it handles redundant files", {
 
 cov <- package_coverage("TestSummary")
 
-context("exclude")
 test_that("it excludes lines", {
   expect_equal(length(cov), 4)
   expect_equal(length(exclude(cov, list("R/TestSummary.R" = 5), path = "TestSummary")), 3)
@@ -149,7 +146,6 @@ test_that("it excludes properly", {
   expect_equal(length(t1), 0)
 })
 
-context("file_exclusions")
 test_that("it returns NULL if empty or no file exclusions", {
   expect_equal(file_exclusions(NULL, ""), NULL)
 
diff --git a/tests/testthat/test-file_coverage.R b/tests/testthat/test-file_coverage.R
index bfaac667..121ab26c 100644
--- a/tests/testthat/test-file_coverage.R
+++ b/tests/testthat/test-file_coverage.R
@@ -1,4 +1,3 @@
-context("file_coverage")
 s1 <- tempfile()
 t1 <- tempfile()
 writeLines(con = s1,
diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R
index 511e37e8..c537498f 100644
--- a/tests/testthat/test-functions.R
+++ b/tests/testthat/test-functions.R
@@ -1,4 +1,3 @@
-context("evaluated functions")
 test_that("function_coverage generates output", {
   env <- new.env()
   withr::with_options(c("keep.source" = TRUE), {
diff --git a/tests/testthat/test-gcov.R b/tests/testthat/test-gcov.R
index a83cfdbd..c3b7dc56 100644
--- a/tests/testthat/test-gcov.R
+++ b/tests/testthat/test-gcov.R
@@ -1,4 +1,3 @@
-context("gcov")
 test_that("parse_gcov parses files properly", {
   mockery::stub(parse_gcov, "file.exists", TRUE)
   mockery::stub(normalize_path, "normalizePath", "simple.c")
diff --git a/tests/testthat/test-gitlab.R b/tests/testthat/test-gitlab.R
index 95d0fd64..6bb83921 100644
--- a/tests/testthat/test-gitlab.R
+++ b/tests/testthat/test-gitlab.R
@@ -1,5 +1,3 @@
-context("gitlab")
-
 test_that("gitlab", {
   cov <- package_coverage("TestS4")
 
diff --git a/tests/testthat/test-memoised.R b/tests/testthat/test-memoised.R
index 2c75d8f5..37b04734 100644
--- a/tests/testthat/test-memoised.R
+++ b/tests/testthat/test-memoised.R
@@ -1,4 +1,3 @@
-context("memoised")
 s1 <- tempfile()
 t1 <- tempfile()
 writeLines(con = s1,
diff --git a/tests/testthat/test-null.R b/tests/testthat/test-null.R
index 721a0680..41e3b664 100644
--- a/tests/testthat/test-null.R
+++ b/tests/testthat/test-null.R
@@ -1,5 +1,3 @@
-context("NULL")
-
 test_that("coverage of functions with NULL constructs", {
   f1 <- function() NULL
   f2 <- function() {
diff --git a/tests/testthat/test-package_coverage.R b/tests/testthat/test-package_coverage.R
index 15836046..6fade55a 100644
--- a/tests/testthat/test-package_coverage.R
+++ b/tests/testthat/test-package_coverage.R
@@ -1,4 +1,3 @@
-context("package_coverage")
 test_that("package_coverage returns an error if the path does not exist", {
   expect_error(package_coverage("blah"))
 })
diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R
index 971a6bb9..64ce2897 100644
--- a/tests/testthat/test-parallel.R
+++ b/tests/testthat/test-parallel.R
@@ -1,6 +1,3 @@
-context("coverage of parallel code")
-
-
 test_that("mcparallel without the fix", {
   skip_on_os("windows")
 
diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
index 5050119f..aeb8c807 100644
--- a/tests/testthat/test-print.R
+++ b/tests/testthat/test-print.R
@@ -1,4 +1,3 @@
-context("print function")
 test_that("format_percentage works as expected", {
   expect_equal(format_percentage(0), crayon::red("0.00%"))
 
diff --git a/tests/testthat/test-record_tests.R b/tests/testthat/test-record_tests.R
index 712f4e70..8e0ad1ff 100644
--- a/tests/testthat/test-record_tests.R
+++ b/tests/testthat/test-record_tests.R
@@ -1,5 +1,3 @@
-context("record_tests")
-
 cov_func <- withr::with_options(
   list(covr.record_tests = TRUE),
   package_coverage(test_path("TestFunctional")))
diff --git a/tests/testthat/test-report.R b/tests/testthat/test-report.R
index a33ad2fb..05799f19 100644
--- a/tests/testthat/test-report.R
+++ b/tests/testthat/test-report.R
@@ -1,5 +1,3 @@
-context("report")
-
 skip_on_ci <- function() {
   if (!identical(Sys.getenv("CI"), "true")) {
     return(invisible(TRUE))
diff --git a/tests/testthat/test-sonarqube.R b/tests/testthat/test-sonarqube.R
index 3204ea07..2bcee65d 100644
--- a/tests/testthat/test-sonarqube.R
+++ b/tests/testthat/test-sonarqube.R
@@ -1,5 +1,3 @@
-context("sonarqube_export")
-
 test_that("it works with coverage objects", {
   tmp <- tempfile()
   cov <- package_coverage(test_path("TestSummary"))
diff --git a/tests/testthat/test-summary.R b/tests/testthat/test-summary.R
index 9e541bbc..a4aea7c4 100644
--- a/tests/testthat/test-summary.R
+++ b/tests/testthat/test-summary.R
@@ -1,5 +1,3 @@
-context("summary_functions")
-
 test_that("Summary gives 50% coverage and two lines with zero coverage", {
   cv <- package_coverage("TestSummary")
   expect_equal(percent_coverage(cv), 50)
diff --git a/tests/testthat/test-trace_calls.R b/tests/testthat/test-trace_calls.R
index a31b96d0..e15fd880 100644
--- a/tests/testthat/test-trace_calls.R
+++ b/tests/testthat/test-trace_calls.R
@@ -1,4 +1,3 @@
-context("trace_calls")
 test_that("one-line functions are traced correctly", {
   old <- getOption("keep.source")
   options(keep.source = TRUE)
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
index f2dc3df5..408cd859 100644
--- a/tests/testthat/test-utils.R
+++ b/tests/testthat/test-utils.R
@@ -1,4 +1,3 @@
-context("as_package")
 test_that("it throws error if no package", {
   expect_error(as_package("arst11234"), "`path` is invalid:.*arst11234")
 })
@@ -15,21 +14,18 @@ test_that("it returns the package if given the root or child directory", {
   expect_equal(as_package("TestS4/tests/testthat")$package, "TestS4")
 })
 
-context("local_branch")
 test_that("it works as expected", {
   with_mock(`covr:::system_output` = function(...) { "test_branch " }, {
     expect_equal(local_branch("TestSummary"), "test_branch")
   })
 })
 
-context("current_commit")
 test_that("it works as expected", {
   with_mock(`covr:::system_output` = function(...) { " test_hash" }, {
   expect_equal(current_commit("TestSummary"), "test_hash")
   })
 })
 
-context("get_source_filename")
 test_that("it works", {
   # R 4.0.0 changes this behavior so `getSrcFilename()` will actually return
   # "test-utils.R"
diff --git a/tests/testthat/test-vectorized.R b/tests/testthat/test-vectorized.R
index 294720e6..774e0ed0 100644
--- a/tests/testthat/test-vectorized.R
+++ b/tests/testthat/test-vectorized.R
@@ -1,4 +1,3 @@
-context("Vectorize")
 s1 = tempfile()
 t1 = tempfile()
 writeLines(con = s1,

From ad71c360c8ec0a21a1bf54045a0e87bc683becf4 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 7 Nov 2024 12:19:22 -0600
Subject: [PATCH 12/25] Run tests in parallel

---
 DESCRIPTION                          |  1 +
 tests/testthat/_snaps/Compiled.md    | 16 +++++++++++++++
 tests/testthat/test-Compiled.R       | 29 +++++++++++++++++++++-------
 tests/testthat/test-tally_coverage.R | 13 -------------
 4 files changed, 39 insertions(+), 20 deletions(-)
 create mode 100644 tests/testthat/_snaps/Compiled.md
 delete mode 100644 tests/testthat/test-tally_coverage.R

diff --git a/DESCRIPTION b/DESCRIPTION
index f87349df..4018a860 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -75,3 +75,4 @@ VignetteBuilder: knitr
 RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
+Config/testthat/parallel: TRUE
diff --git a/tests/testthat/_snaps/Compiled.md b/tests/testthat/_snaps/Compiled.md
new file mode 100644
index 00000000..ca5fb739
--- /dev/null
+++ b/tests/testthat/_snaps/Compiled.md
@@ -0,0 +1,16 @@
+# Error thrown for missing gcov
+
+    Code
+      package_coverage("TestCompiled", relative_path = TRUE)
+    Condition
+      Error in `run_gcov()`:
+      ! gcov not found
+
+# Warning thrown for empty gcov output
+
+    Code
+      . <- package_coverage("TestCompiled", relative_path = TRUE)
+    Condition
+      Warning in `run_gcov()`:
+      parsed gcov output was empty
+
diff --git a/tests/testthat/test-Compiled.R b/tests/testthat/test-Compiled.R
index 51689de3..f93e7b85 100644
--- a/tests/testthat/test-Compiled.R
+++ b/tests/testthat/test-Compiled.R
@@ -78,16 +78,31 @@ test_that("Compiled code coverage is reported under non-standard char's", {
 
 test_that("Error thrown for missing gcov", {
   skip_on_cran()
-  withr::with_options(c(covr.gcov=''),
-    expect_error(package_coverage("TestCompiled", relative_path=TRUE),
-                 "gcov not found")
-  )
+
+  withr::local_options(covr.gcov='')
+  expect_snapshot(package_coverage("TestCompiled", relative_path=TRUE), error = TRUE)
 })
 
 test_that("Warning thrown for empty gcov output", {
   skip_on_cran()
-  withr::with_options(c(covr.gcov_args='-n'),
-    expect_warning(package_coverage("TestCompiled", relative_path=TRUE),
-                   "parsed gcov output was empty")
+
+  withr::local_options(covr.gcov_args='-n')
+  expect_snapshot(
+    . <- package_coverage("TestCompiled", relative_path=TRUE),
+    transform = function(x) gsub(getwd(), "<wd>", x)
   )
 })
+
+test_that("tally_coverage includes compiled code", {
+  skip_on_cran()
+  skip_if(is_win_r41())
+
+  cov <- package_coverage(test_path("TestCompiled"))
+  tall <- tally_coverage(cov)
+
+  expect_named(tall, c("filename", "functions", "line", "value"))
+
+  expect_equal(
+    unique(tall$filename),
+    c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc"))
+})
diff --git a/tests/testthat/test-tally_coverage.R b/tests/testthat/test-tally_coverage.R
deleted file mode 100644
index 93173766..00000000
--- a/tests/testthat/test-tally_coverage.R
+++ /dev/null
@@ -1,13 +0,0 @@
-test_that("tally_coverage includes compiled code", {
-  skip_on_cran()
-  skip_if(is_win_r41())
-
-  cov <- package_coverage(test_path("TestCompiled"))
-  tall <- tally_coverage(cov)
-
-  expect_named(tall, c("filename", "functions", "line", "value"))
-
-  expect_equal(
-    unique(tall$filename),
-    c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc"))
-})

From 459217f4e2daccfc6c3de59eef00b67225cc8d39 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 15:42:55 -0500
Subject: [PATCH 13/25] add S7 to Suggests

---
 DESCRIPTION | 1 +
 1 file changed, 1 insertion(+)

diff --git a/DESCRIPTION b/DESCRIPTION
index 35845bed..7ded0970 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -56,6 +56,7 @@ Imports:
     yaml
 Suggests:
     R6,
+    S7,
     curl,
     knitr,
     rmarkdown,

From 4add15bd1b1a6d50572ae1262886ee07c5704ad3 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 16:20:42 -0500
Subject: [PATCH 14/25] Revert "update expected validator run counts in tests:
 3 -> 4"

This reverts commit 8058180326b9bb71b003ac2175d56b8d9c14bdb4.
---
 tests/testthat/test-S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index 45af3fa7..9b5d0632 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
   cov <- as.data.frame(package_coverage("TestS7"))
 
-  expect_equal(cov$value, c(1, 1, 1, 1, 4, 0, 4, 0, 4, 1, 1))
+  expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
 })

From efbbd52076daf256f44717f5038f03a43a00b401 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 16:31:26 -0500
Subject: [PATCH 15/25] Use `S7::prop()` instead of `@` for R oldrel compat

---
 R/S7.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/S7.R b/R/S7.R
index aaf109b2..2cc27088 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -29,7 +29,7 @@ traverse_S7_generic <- function(x) {
 
 traverse_S7_class <- function(x) {
   prop_fun_replacements <-
-    lapply(x@properties, function(p) {
+    lapply(S7::prop(x, "properties"), function(p) {
       lapply(c("getter", "setter", "validator"), function(prop_fun) {
         if (!is.null(p[[prop_fun]])) {
           replacement(prop_fun, env = p, target_value = p[[prop_fun]])
@@ -40,9 +40,9 @@ traverse_S7_class <- function(x) {
 
   c(
     list(
-      replacement("constructor", env = x, target_value=x@constructor),
-      replacement("validator", env = x, target_value=x@validator)
+      replacement("constructor", env = x, target_value = S7::prop(x, "constructor")),
+      replacement("validator"  , env = x, target_value = S7::prop(x, "validator"))
     ),
     prop_fun_replacements
   )
-}
\ No newline at end of file
+}

From f228960022036614ff35395371f07e7e979eae60 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 18:41:37 -0500
Subject: [PATCH 16/25] import backported `@` in TestS7 package

---
 tests/testthat/TestS7/DESCRIPTION | 2 +-
 tests/testthat/TestS7/NAMESPACE   | 3 +++
 tests/testthat/TestS7/R/foo.R     | 5 +++++
 3 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/tests/testthat/TestS7/DESCRIPTION b/tests/testthat/TestS7/DESCRIPTION
index 5d220743..33f0c65f 100644
--- a/tests/testthat/TestS7/DESCRIPTION
+++ b/tests/testthat/TestS7/DESCRIPTION
@@ -10,7 +10,7 @@ Description: What the package does (one paragraph).
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Imports: S7
 Suggests: 
     testthat (>= 3.0.0)
diff --git a/tests/testthat/TestS7/NAMESPACE b/tests/testthat/TestS7/NAMESPACE
index 587cf7fc..3e02b753 100644
--- a/tests/testthat/TestS7/NAMESPACE
+++ b/tests/testthat/TestS7/NAMESPACE
@@ -1,3 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(Range)
+export(inside)
+if (getRversion() < "4.3.0") importFrom("S7", "@")
 import(S7)
diff --git a/tests/testthat/TestS7/R/foo.R b/tests/testthat/TestS7/R/foo.R
index 786934db..13c4a6a6 100644
--- a/tests/testthat/TestS7/R/foo.R
+++ b/tests/testthat/TestS7/R/foo.R
@@ -1,4 +1,5 @@
 #' @import S7
+#' @export
 Range <- new_class("Range",
   properties = list(
     start = class_double,
@@ -32,3 +33,7 @@ inside <- new_generic("inside", "x")
 method(inside, Range) <- function(x, y) {
   y >= x@start & y <= x@end
 }
+
+# enable usage of <S7_object>@name in package code
+#' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")
+NULL

From 085939a2ccc0ec77f949e702ddd817518a06cef1 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 19:10:02 -0500
Subject: [PATCH 17/25] stray `@` -> `S7::prop()` replacement

---
 R/S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/S7.R b/R/S7.R
index 2cc27088..c38a7532 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -24,7 +24,7 @@ traverse_S7_generic <- function(x) {
     })
     unlist(replacements, FALSE, FALSE)
   }
-  get_replacements(x@methods)
+  get_replacements(S7::prop(x, "methods"))
 }
 
 traverse_S7_class <- function(x) {

From 6583c1313934a35c9242f38114bd59daa85d21ad Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 19:11:01 -0500
Subject: [PATCH 18/25] return of `test_path()`

---
 tests/testthat/test-S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index 9b5d0632..fb096857 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
-  cov <- as.data.frame(package_coverage("TestS7"))
+  cov <- as.data.frame(package_coverage(test_path("TestS7")))
 
   expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
 })

From 1636d1262e4a131c5359d2c59b178fc0629a0fb1 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Thu, 7 Nov 2024 19:21:49 -0500
Subject: [PATCH 19/25] Class validator runs 4 times, not 3

---
 tests/testthat/test-S7.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index fb096857..0ba7a8b5 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
   cov <- as.data.frame(package_coverage(test_path("TestS7")))
 
-  expect_equal(cov$value, c(1, 1, 1, 1, 3, 0, 3, 0, 3, 1, 1))
+  expect_equal(cov$value, c(1, 1, 1, 1, 4, 0, 4, 0, 4, 1, 1))
 })

From 59b1f7e7dc9cdad8d753f052b96a26eee4bef144 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Fri, 8 Nov 2024 07:33:52 -0500
Subject: [PATCH 20/25] Install S7 >= 0.2.0

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7ded0970..d72b1226 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -56,7 +56,7 @@ Imports:
     yaml
 Suggests:
     R6,
-    S7,
+    S7 (>= 0.2.0),
     curl,
     knitr,
     rmarkdown,

From 580544d5c7e9318aef78eb15edc53564e4c6254b Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 8 Nov 2024 11:18:09 -0500
Subject: [PATCH 21/25] better names in coverage report

Give the `cov$functions` columns more informative names, for interactive development. E.g.:

> cov$functions
 [1] "Range@properties$length$getter"
 [2] "Range@properties$length$setter"
 [3] "Range@properties$length$setter"
 [4] "Range@constructor"
 [5] "Range@validator"
 [6] "Range@validator"
 [7] "Range@validator"
 [8] "Range@validator"
 [9] "Range@validator"
[10] "Range@validator"
[11] "method(inside, TestS7::Range)"
---
 R/S7.R | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/R/S7.R b/R/S7.R
index c38a7532..26931b44 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -19,6 +19,7 @@ traverse_S7_generic <- function(x) {
         # Recurse for nested environments
         get_replacements(target_value)
       } else {
+        name <- as.character(attr(target_value, "name", TRUE) %||% name)
         list(replacement(name, env, target_value))
       }
     })
@@ -28,11 +29,15 @@ traverse_S7_generic <- function(x) {
 }
 
 traverse_S7_class <- function(x) {
+  class_name <- S7::prop(x, "name")
   prop_fun_replacements <-
     lapply(S7::prop(x, "properties"), function(p) {
       lapply(c("getter", "setter", "validator"), function(prop_fun) {
         if (!is.null(p[[prop_fun]])) {
-          replacement(prop_fun, env = p, target_value = p[[prop_fun]])
+          replacement(
+            sprintf("%s@properties$%s$%s", class_name, p$name, prop_fun),
+            env = p,
+            target_value = p[[prop_fun]])
         }
       })
   })
@@ -40,8 +45,8 @@ traverse_S7_class <- function(x) {
 
   c(
     list(
-      replacement("constructor", env = x, target_value = S7::prop(x, "constructor")),
-      replacement("validator"  , env = x, target_value = S7::prop(x, "validator"))
+      replacement(paste0(class_name, "@constructor"), env = x, target_value = S7::prop(x, "constructor")),
+      replacement(paste0(class_name, "@validator")  , env = x, target_value = S7::prop(x, "validator"))
     ),
     prop_fun_replacements
   )

From 5d1cafa1c84113002bcb1092a4303803693cb6a9 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 8 Nov 2024 12:08:00 -0500
Subject: [PATCH 22/25] Add support for S7 methods registered for external
 generics

---
 R/S7.R                                        | 33 ++++++++++++++++++-
 tests/testthat/TestS7/R/foo.R                 | 15 +++++++++
 .../testthat/TestS7/tests/testthat/test-foo.R |  8 +++++
 tests/testthat/_snaps/S7.md                   | 22 +++++++++++++
 tests/testthat/test-S7.R                      |  4 ++-
 5 files changed, 80 insertions(+), 2 deletions(-)
 create mode 100644 tests/testthat/_snaps/S7.md

diff --git a/R/S7.R b/R/S7.R
index 26931b44..e76c9afa 100644
--- a/R/S7.R
+++ b/R/S7.R
@@ -1,5 +1,5 @@
 replacements_S7 <- function(env) {
-  unlist(recursive = FALSE, use.names = FALSE, eapply(env, all.names = TRUE,
+  bindings <- unlist(recursive = FALSE, use.names = FALSE, eapply(env, all.names = TRUE,
     function(obj) {
       if (inherits(obj, "S7_generic")) {
         traverse_S7_generic(obj)
@@ -7,6 +7,21 @@ replacements_S7 <- function(env) {
         traverse_S7_class(obj)
       }
     }))
+
+  S7_methods_tbl <- attr(env[[".__S3MethodsTable__."]], "S7methods", TRUE)
+  external_methods <- lapply(seq_along(S7_methods_tbl), function(i) {
+    entry <- S7_methods_tbl[[i]]
+    name <- external_generic_method_signature(entry$generic, entry$signature)
+
+    replacement(
+      # `name` is for informative printouts only.
+      # It is not used by covr, and does not need to be unique,
+      name = name,
+      env = entry,
+      target_value = entry$method)
+  })
+
+  c(bindings, external_methods)
 }
 
 traverse_S7_generic <- function(x) {
@@ -51,3 +66,19 @@ traverse_S7_class <- function(x) {
     prop_fun_replacements
   )
 }
+
+
+external_generic_method_signature <- function(generic, signature) {
+  # This function is a lightly modified copy of S7:::method_signature() for external generics
+  display_generic <- paste0(c(generic$package, generic$name), collapse = "::")
+  class_deparse <- asNamespace("S7")$class_deparse # not exported from S7 :/
+  single <- length(generic$dispatch_args) == 1
+  if (single) {
+    signature <- class_deparse(signature[[1]])
+  } else {
+    classes <- vapply(signature, class_deparse, "", USE.NAMES = FALSE)
+    signature <- paste0("list(", paste0(classes, collapse = ", "), ")")
+  }
+
+  sprintf("method(%s, %s)", display_generic, signature)
+}
diff --git a/tests/testthat/TestS7/R/foo.R b/tests/testthat/TestS7/R/foo.R
index 13c4a6a6..77060924 100644
--- a/tests/testthat/TestS7/R/foo.R
+++ b/tests/testthat/TestS7/R/foo.R
@@ -37,3 +37,18 @@ method(inside, Range) <- function(x, y) {
 # enable usage of <S7_object>@name in package code
 #' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")
 NULL
+
+# test external S3 generics
+method(format, Range) <- function(x) {
+  sprintf("Range(%s, %s)", x@start, x@end)
+}
+
+testthat_print <- new_external_generic("testthat", "testthat_print", "x")
+method(testthat_print, Range) <- function(x, ...) {
+  cat(format(x))
+  invisible(x)
+}
+
+.onLoad <- function(libname, pkgname) {
+  S7::methods_register()
+}
\ No newline at end of file
diff --git a/tests/testthat/TestS7/tests/testthat/test-foo.R b/tests/testthat/TestS7/tests/testthat/test-foo.R
index 0af07179..5877d020 100644
--- a/tests/testthat/TestS7/tests/testthat/test-foo.R
+++ b/tests/testthat/TestS7/tests/testthat/test-foo.R
@@ -14,3 +14,11 @@ test_that("Range works", {
   expect_equal(x@length, 5)
   expect_equal(x@end, 6)
 })
+
+test_that("Range methods work", {
+  x <- Range(1:10)
+  expect_equal(base::format(x), "Range(1, 10)")
+
+  # Test external generic method for testthat::testthat_print()
+  expect_equal(testthat::capture_output(x, print = TRUE), "Range(1, 10)")
+})
\ No newline at end of file
diff --git a/tests/testthat/_snaps/S7.md b/tests/testthat/_snaps/S7.md
new file mode 100644
index 00000000..50a3e336
--- /dev/null
+++ b/tests/testthat/_snaps/S7.md
@@ -0,0 +1,22 @@
+# S7 coverage is reported
+
+    Code
+      cov[, c("functions", "first_line", "last_line", "value")]
+    Output
+                                               functions first_line last_line value
+      1                   Range@properties$length$getter          9         9     1
+      2                   Range@properties$length$setter         11        11     1
+      3                   Range@properties$length$setter         12        12     1
+      4                                            Range         17        17     2
+      5                                  Range@validator         20        20     5
+      6                                  Range@validator         21        21     0
+      7                                  Range@validator         22        22     5
+      8                                  Range@validator         23        23     0
+      9                                  Range@validator         24        24     5
+      10                                 Range@validator         25        25     1
+      11                   method(inside, TestS7::Range)         34        34     1
+      12             method(base::format, TestS7::Range)         43        43     2
+      13 method(testthat::testthat_print, TestS7::Range)         48        48     1
+      14 method(testthat::testthat_print, TestS7::Range)         49        49     1
+      15                                         .onLoad         53        53     0
+
diff --git a/tests/testthat/test-S7.R b/tests/testthat/test-S7.R
index 0ba7a8b5..c5ce0dbc 100644
--- a/tests/testthat/test-S7.R
+++ b/tests/testthat/test-S7.R
@@ -1,5 +1,7 @@
 test_that("S7 coverage is reported", {
+  local_edition(3)
   cov <- as.data.frame(package_coverage(test_path("TestS7")))
 
-  expect_equal(cov$value, c(1, 1, 1, 1, 4, 0, 4, 0, 4, 1, 1))
+  expect_equal(cov$value, c(1, 1, 1, 2, 5, 0, 5, 0, 5, 1, 1, 2, 1, 1, 0))
+  expect_snapshot(cov[, c("functions", "first_line", "last_line", "value")])
 })

From 0aa82ed720b7723e6c314398eb1cd4445bf39459 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 8 Nov 2024 12:09:44 -0500
Subject: [PATCH 23/25] enable `workflow_dispatch` for R-CMD-check action

---
 .github/workflows/R-CMD-check.yaml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index ee65ccb5..5df3051d 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -5,6 +5,7 @@
 # check-standard.yaml is likely a better choice.
 # usethis::use_github_action("check-standard") will install it.
 on:
+  workflow_dispatch:
   push:
     branches: [main, master]
   pull_request:

From c27deac4ddd27d2b6bd42d691d641d8a5fae2dcc Mon Sep 17 00:00:00 2001
From: Kyle Meyer <kyle@kyleam.com>
Date: Tue, 19 Nov 2024 12:29:46 -0500
Subject: [PATCH 24/25] parse_data: Fix compatibility with R 4.4 (#588)

* split_on_line_directives: guard against input without a directive

get_parse_data extracts lines from the input srcfile object and feeds
them to split_on_line_directives, which expects the lines to be a
concatenation of all the package R files, separated by #line
directives.

With how get_parse_data is currently called, that expectation is met.
get_parse_data is called only if utils::getParseData returns NULL, and
getParseData doesn't return NULL for any of the cases where the input
does _not_ have line directives (i.e. entry points other than
package_coverage).

An upcoming commit is going to move the get_parse_data call in front
of the getParseData call, so update split_on_line_directives to detect
the "no directives" case.

Without this guard, the mapply call in split_on_line_directives would
error under an R version before 4.2; with R 4.2 or later,
split_on_line_directives returns empty.

* split_on_line_directives: fix handling of single-file package case

split_on_line_directives breaks the input at #line directives and
returns a named list of lines for each file.

For a package with a single file under R/, there is one directive.
The bounds calculation is still correct for that case.  However, the
return value is incorrectly a matrix rather than a list because the
mapply call simplifies the result.

At this point, this bug is mostly [*] unexposed because this code path
is only triggered if utils::getParseData returns NULL, and it should
always return a non-NULL result for the single-file package case.  The
next commit will reorder things, exposing the bug.

Tell mapply to not simplify the result.

[*] The simplification to a matrix could also happen for multi-file
    packages in the unlikely event that all files have the same number
    of lines.

* parse_data: promote custom parse logic for R 4.4 compatibility

utils::getParseData has a longstanding bug: for an installed package,
parse data is available only for the last file [1].  To work around
that, the get_tokens helper first calls getParseData and then falls
back to custom logic that extracts the concatenated source lines,
splits them on #line directives, and calls getParseData on each file's
lines.

The getParseData bug was fixed in R 4.4.0 (r84538).  Unfortunately
that change causes at least two issues (for some subset of packages):
a substantial performance regression [2] and an error when applying
exclusions [3].

Under R 4.4, getParseData always returns non-NULL as a result of that
change when calculating package coverage (in other words, the
get_parse_data fallback is _not_ triggered).  The slowdown is
partially due to the parse data no longer being cached across
get_tokens calls.  Another relevant aspect, for both the slowdown and
the error applying exclusions, is likely that the new getParseData
returns data for the entire package rather than the per-file parse
data the downstream covr code expects.

One solution would be to adapt covr's caching and handling of the
getParseData when running under R 4.4.0 or later.  Instead go with a
simpler and more minimal fix.  Reorder the calls so that the
get_parse_data call, which we know has been the primary code path for
package coverage before R 4.4.0, is the first call tried.  Leave
getParseData as the fallback to handle the non-package coverage cases.

[1] https://github.com/r-lib/covr/pull/154
    https://bugs.r-project.org/show_bug.cgi?id=16756

[2] As an extreme case, calling package_coverage on R.utils goes from
    under 15 minutes to over 6 hours.

[3] nanotime (v0.3.10) and diffobj (v0.3.5) are two examples of
    packages that hit into this error.

Closes #576
Closes #579
Re: #567
---
 NEWS.md                     |  3 +++
 R/parse_data.R              | 20 +++++++++++---
 R/utils.R                   | 11 +++++++-
 tests/testthat/test-utils.R | 52 +++++++++++++++++++++++++++++++++++++
 4 files changed, 82 insertions(+), 4 deletions(-)

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

From ca4241da03a30b76a8d8cbfc194371cb94ca512e Mon Sep 17 00:00:00 2001
From: Greg Freedman Ellis <greg.freedman@gmail.com>
Date: Tue, 19 Nov 2024 11:35:31 -0600
Subject: [PATCH 25/25] Fix bug when using non-absolute install_path (#548)

* normalize install_path

* update NEWS
---
 NEWS.md  | 1 +
 R/covr.R | 2 ++
 2 files changed, 3 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 491f452f..1a9ed599 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,5 @@
 # covr (development version)
+* Fix a bug preventing `package_coverage()` from running tests when `install_path` is set to a relative path (@gergness, #517, #548).
 
 * Fixed a performance regression and an error triggered by a change in R
   4.4.0. (@kyleam, #588)
diff --git a/R/covr.R b/R/covr.R
index bf52d51a..575a0f83 100644
--- a/R/covr.R
+++ b/R/covr.R
@@ -411,6 +411,8 @@ package_coverage <- function(path = ".",
   }
 
   dir.create(install_path)
+  # tools::testInstalledPackage requires normalized install_path (#517)
+  install_path <- normalize_path(install_path)
 
   flags <- getOption("covr.flags")