Various fixes to interactive test running

.github/workflows/devtools-test.yaml

@@ -0,0 +1,77 @@
+on: [push, pull_request]
+
+name: devtools-test
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+
+    env:
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      RSPM: ${{ matrix.config.rspm }}
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          r-version: ${{ matrix.config.r }}
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
+        shell: Rscript {0}
+
+      - name: Cache R packages
+        if: runner.os != 'Windows'
+        uses: actions/cache@v2
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
+
+      - name: Install system dependencies
+        if: runner.os == 'Linux'
+        run: |
+          while read -r cmd
+          do
+            eval sudo $cmd
+          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
+
+      - name: Install dependencies
+        run: |
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("devtools")
+        shell: Rscript {0}
+
+      - name: Run devtools::test twice
+        run: |
+          run1 <- as.data.frame(devtools::test())
+          if (sum(run1$error, run1$failed, run1$warning) > 0) {
+            stop("Tests did not pass with devtools::test()")
+          }
+          run2 <- as.data.frame(devtools::test())
+          if (sum(run2$error, run2$failed, run2$warning) > 0) {
+            stop("Tests did not pass with devtools::test() when re-running (global state was modified)")
+          }
+        shell: Rscript {0}
+
+      - name: Upload check results
+        if: failure()
+        uses: actions/upload-artifact@main
+        with:
+          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
+          path: check

DESCRIPTION

@@ -39,7 +39,7 @@ Suggests:
     spelling,
     xml2
 Language: en-US
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
 Config/testthat/edition: 3

R/find-redactor.R

@@ -32,7 +32,12 @@
 #' @seealso [set_requester()]
 set_redactor <- function (FUN) {
     FUN <- prepare_redactor(FUN)
-    options(httptest.redactor=FUN)
+    options(
+        httptest.redactor=FUN,
+        ## Because we're directly setting a redactor, remove any record that
+        ## a previous redactor was set by reading from packages
+        httptest.redactor.packages=NULL
+    )
     invisible(FUN)
 }
 
@@ -101,7 +106,8 @@ get_current_redactor <- function () {
     out <- getOption("httptest.redactor")
     if (is.null(out)) {
         ## Set the default
-        out <- set_redactor(default_redactor())
+        out <- default_redactor()
+        options(httptest.redactor=out)
     } else {
         ## See if default is based on packages and needs refreshing
         pkgs <- getOption("httptest.redactor.packages")
@@ -112,7 +118,8 @@ get_current_redactor <- function () {
             ## Also, always reevaluate the default redactor if pkgload is involved
             if ("pkgload" %in% loadedNamespaces() || !identical(current_packages, pkgs)) {
                 ## Re-evaluate
-                out <- set_redactor(default_redactor(current_packages))
+                out <- default_redactor(current_packages)
+                options(httptest.redactor=out)
             }
         }
     }

R/find-requester.R

@@ -14,7 +14,12 @@
 #' @seealso [set_redactor()]
 set_requester <- function (FUN) {
     FUN <- prepare_redactor(FUN)
-    options(httptest.requester=FUN)
+    options(
+        httptest.requester=FUN,
+        ## Because we're directly setting a redactor, remove any record that
+        ## a previous redactor was set by reading from packages
+        httptest.requester.packages=NULL
+    )
     invisible(FUN)
 }
 
@@ -42,7 +47,8 @@ get_current_requester <- function () {
     out <- getOption("httptest.requester")
     if (is.null(out)) {
         ## Set the default
-        out <- set_requester(default_requester())
+        out <- default_requester()
+        options(httptest.requester=out)
     } else {
         ## See if default is based on packages and needs refreshing
         pkgs <- getOption("httptest.requester.packages")
@@ -52,7 +58,8 @@ get_current_requester <- function () {
             current_packages <- get_attached_packages()
             if (!identical(current_packages, pkgs)) {
                 ## Re-evaluate
-                out <- set_requester(default_requester(current_packages))
+                out <- default_requester(current_packages)
+                options(httptest.requester=out)
             }
         }
     }

R/vignette.R

@@ -39,6 +39,7 @@ start_vignette <- function (path, ...) {
     ## And don't print messages in a vignette
     options(
         httptest.mock.paths.old=getOption("httptest.mock.paths"),
+        httptest.verbose.old=getOption("httptest.verbose"),
         httptest.verbose=FALSE
     )
     ## This actually sources the files, if they exist
@@ -93,9 +94,10 @@ end_vignette <- function () {
     ## This actually sources the files, if they exist
     find_package_functions(get_attached_packages(), "end-vignette.R")
 
-    ## Restore original .mockPaths
+    ## Restore original settings
     options(
         httptest.mock.paths=getOption("httptest.mock.paths.old"),
-        httptest.mock.paths.old=NULL
+        httptest.mock.paths.old=NULL,
+        httptest.verbose=getOption("httptest.verbose.old")
     )
 }

tests/testthat/setup.R

@@ -20,11 +20,24 @@ capture_while_mocking <- function (..., path) {
 
 with_redactor <- function (x, ...) {
     old <- getOption("httptest.redactor")
+    old.pkgs <- getOption("httptest.redactor.packages")
     set_redactor(x)
-    on.exit(set_redactor(old))
+    on.exit({
+      set_redactor(old)
+      options(httptest.redactor.packages=old.pkgs)
+    })
     eval.parent(...)
 }
 
+reset_redactors <- function() {
+  options(
+    httptest.redactor=NULL,
+    httptest.redactor.packages=NULL,
+    httptest.requester=NULL,
+    httptest.requester.packages=NULL
+  )
+}
+
 ## from __future__ import ...
 if ("Rcmd" %in% ls(envir=asNamespace("tools"))) {
     Rcmd <- tools::Rcmd
@@ -69,4 +82,3 @@ testthat_transition <- function(old, new) {
 
 # assign to global to be used inside of `public()` calls
 third_edition <<- tryCatch(testthat::edition_get() == 3, error = function(e) FALSE)
-

tests/testthat/test-find-redactor.R

@@ -53,7 +53,6 @@ with_mock_api({
                         lib <- install_testpkg("testpkg")
                         library(testpkg, lib.loc=lib)
                         expect_true("testpkg" %in% names(sessionInfo()$otherPkgs))
-
                         r <- GET("http://example.com/get")
                     }),
                     paste0("Using redact.R from ", dQuote("testpkg"))
@@ -94,10 +93,7 @@ with_mock_api({
     test_that("Loading a package with pkgload (devtools)", {
         newmocks3 <- tempfile()
         expect_false("testpkg" %in% names(sessionInfo()$otherPkgs))
-        on.exit({
-            pkgload::unload("testpkg")
-            unloadNamespace("pkgload")
-        })
+        on.exit(pkgload::unload("testpkg"))
         expect_message(
             capture_while_mocking(path=newmocks3, {
                 pkgload::load_all("testpkg", quiet = TRUE)
@@ -113,3 +109,5 @@ with_mock_api({
         expect_identical(content(r2), list(fake=TRUE))
     })
 })
+
+reset_redactors()

tests/testthat/test-public.R

@@ -4,6 +4,7 @@ test_that("Functions not exported can be found", {
 
 public({
     test_that("If a function is not exported, the public test context errors", {
+        skip_if(pkgload::is_dev_package("httptest")) # load_all puts everything in the global env
         expect_error(.internalFunction(),
             'could not find function ".internalFunction"')
     })

tests/testthat/test-redact.R

@@ -164,16 +164,15 @@ with_mock_api({
         expect_identical(content(r), list(loaded=TRUE))
     })
     test_that("But the mock file gets written to the modified path with altered content", {
-        options(httptest.mock.paths=d)  ## Do this way to make sure "." isn't in
-                                        ## the search path. We're checking that
-                                        ## the original request doesn't have a
-                                        ## mock, but of course we made it from
-                                        ## a mock in the working directory
-        on.exit(options(httptest.mock.paths=NULL))
-        expect_GET(GET("http://example.com/get"),
-            "http://example.com/get")
-        expect_error(alt <- GET("http://example.com/fakeurl"), NA)
-        expect_identical(content(alt), list(changed=TRUE))
+        ## Use replace=TRUE to make sure that "." isn't in the search path.
+        ## We're checking that the original request doesn't have a mock,
+        ## but of course we made it from a mock in the working directory
+        with_mock_path(d, replace=TRUE, {
+          expect_GET(GET("http://example.com/get"),
+              "http://example.com/get")
+          expect_error(alt <- GET("http://example.com/fakeurl"), NA)
+          expect_identical(content(alt), list(changed=TRUE))
+        })
     })
 
     a <- GET("api/", add_headers(`Authorization`="Bearer token"))
@@ -229,3 +228,5 @@ test_that("chain_redactors", {
     expect_equal(f12(5), 23)
     expect_equal(f21(5), 32)
 })
+
+reset_redactors()

tests/testthat/test-vignette.R

@@ -31,6 +31,7 @@ test_that("start/end_vignette with mocking (dir exists)", {
 test_that("start/end_vignette calls inst/httptest/vignette-start/end.R", {
     lib <- install_testpkg("testpkg")
     library(testpkg, lib.loc=lib)
+    on.exit(detach("package:testpkg", unload=TRUE))
     expect_false(getOption("testpkg.start.vignette", FALSE))
     start_vignette(path)
     expect_true(getOption("testpkg.start.vignette"))
@@ -44,3 +45,5 @@ test_that("change_state validation", {
         expect_error(change_state(), "foo is not valid for change_state()")
     })
 })
+
+reset_redactors()