Extract out helper to make coverage easier

Fixes #544

R/test.R

@@ -20,7 +20,7 @@ request_test <- function(template = "/get", ...) {
 #' @export
 example_url <- function() {
   check_installed("webfakes")
-  if (is_testing()) {
+  if (is_testing() && !is_interactive()) {
     testthat::skip_on_covr()
   }
 

tests/testthat/helper-webfakes.R

@@ -0,0 +1,15 @@
+local_app_request <- function(get, frame = parent.frame()) {
+  # Works interactively (useful for manaul coverage checking)
+  # but not in separate process
+  if (!is_interactive()) {
+    skip_on_covr()
+  }
+
+  app <- webfakes::new_app()
+  app$get("/test", get)
+  server <- webfakes::local_app_process(app, .local_envir = frame)
+
+  req <- request(server$url("/test"))
+  req <- req_error(req, body = function(resp) resp_body_string(resp))
+  req
+}

tests/testthat/test-oauth-flow-auth-code.R

@@ -125,15 +125,12 @@ test_that("external auth code sources are detected correctly", {
 
 test_that("auth codes can be retrieved from an external source", {
   skip_on_cran()
-  skip_on_covr()
 
-  app <- webfakes::new_app()
-  authorized <- FALSE
-
-  # Error on first, and then respond on second
-  app$get("/code", function(req, res) {
+  req <- local_app_request(function(req, res) {
+    # Error on first, and then respond on second
+    authorized <- res$app$locals$authorized %||% FALSE
     if (!authorized) {
-      authorized <<- TRUE
+      res$app$locals$authorized <- TRUE
       res$
         set_status(404L)$
         set_type("text/plain")$
@@ -144,8 +141,7 @@ test_that("auth codes can be retrieved from an external source", {
         send_json(text = '{"code":"abc123"}')
     }
   })
-  server <- webfakes::local_app_process(app)
 
-  withr::local_envvar("HTTR2_OAUTH_CODE_SOURCE_URL" = server$url("/code"))
+  withr::local_envvar("HTTR2_OAUTH_CODE_SOURCE_URL" = req$url)
   expect_equal(oauth_flow_auth_code_fetch("ignored"), "abc123")
 })

tests/testthat/test-req-perform-connection.R

@@ -15,21 +15,17 @@ test_that("can read all data from a connection", {
 })
 
 test_that("reads body on error", {
-  app <- webfakes::new_app()
-  app$get("/fail", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$set_status(404L)$send_json(list(status = 404), auto_unbox = TRUE)
   })
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/fail"))
 
   expect_error(req_perform_connection(req), class = "httr2_http_404")
   resp <- last_response()
   expect_equal(resp_body_json(resp), list(status = 404))
 })
 
 test_that("can retry a transient error", {
-  app <- webfakes::new_app()
-  app$get("/retry", function(req, res) {
+  req <- local_app_request(function(req, res) {
     i <- res$app$locals$i %||% 1
     if (i == 1) {
       res$app$locals$i <- 2
@@ -41,10 +37,7 @@ test_that("can retry a transient error", {
       res$send_json(list(status = "done"), auto_unbox = TRUE)
     }
   })
-
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/retry")) %>%
-    req_retry(max_tries = 2)
+  req <- req_retry(req, max_tries = 2)
 
   cnd <- expect_condition(
     resp <- req_perform_connection(req),

tests/testthat/test-req-perform.R

@@ -55,10 +55,7 @@ test_that("persistent HTTP errors only get single attempt", {
 })
 
 test_that("can retry a transient error", {
-  skip_on_covr()
-  app <- webfakes::new_app()
-
-  app$get("/retry", function(req, res) {
+  req <- local_app_request(function(req, res) {
     i <- res$app$locals$i %||% 1
     if (i == 1) {
       res$app$locals$i <- 2
@@ -70,10 +67,7 @@ test_that("can retry a transient error", {
       res$send_json(list(status = "done"))
     }
   })
-
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/retry")) %>%
-    req_retry(max_tries = 2)
+  req <- req_retry(req, max_tries = 2)
 
   cnd <- catch_cnd(resp <- req_perform(req), "httr2_retry")
   expect_s3_class(cnd, "httr2_retry")

tests/testthat/test-resp-stream.R

@@ -28,15 +28,11 @@ test_that("can't read from a closed connection", {
 })
 
 test_that("can join lines across multiple reads", {
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$send_chunk("This is a ")
     Sys.sleep(0.2)
     res$send_chunk("complete sentence.\n")
   })
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
 
   # Non-blocking returns NULL until data is ready
   resp1 <- req_perform_connection(req, blocking = FALSE)
@@ -54,9 +50,7 @@ test_that("can join lines across multiple reads", {
 })
 
 test_that("handles line endings of multiple kinds", {
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$set_header("Content-Type", "text/plain; charset=Shift_JIS")
     res$send_chunk(as.raw(c(0x82, 0xA0, 0x0A)))
     Sys.sleep(0.1)
@@ -77,9 +71,6 @@ test_that("handles line endings of multiple kinds", {
     res$send_chunk("eof without line ending")
   })
 
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
-
   resp1 <- req_perform_connection(req, blocking = TRUE)
   withr::defer(close(resp1))
 
@@ -118,15 +109,10 @@ test_that("handles line endings of multiple kinds", {
 })
 
 test_that("streams the specified number of lines", {
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$send_chunk(paste0(letters[1:5], "\n", collapse = ""))
   })
 
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
-
   resp1 <- req_perform_connection(req, blocking = TRUE)
   withr::defer(close(resp1))
   expect_equal(
@@ -160,16 +146,11 @@ test_that("streams the specified number of lines", {
 })
 
 test_that("can feed sse events one at a time", {
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     for(i in 1:3) {
       res$send_chunk(sprintf("data: %s\n\n", i))
     }
   })
-
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
   resp <- req_perform_connection(req)
   withr::defer(close(resp))
 
@@ -187,19 +168,14 @@ test_that("can feed sse events one at a time", {
 })
 
 test_that("can join sse events across multiple reads", {
-  # skip_on_covr()
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$send_chunk("data: 1\n")
     Sys.sleep(0.2)
     res$send_chunk("data")
     Sys.sleep(0.2)
     res$send_chunk(": 2\n")
     res$send_chunk("\ndata: 3\n\n")
   })
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
 
   # Non-blocking returns NULL until data is ready
   resp1 <- req_perform_connection(req, blocking = FALSE)
@@ -227,14 +203,9 @@ test_that("can join sse events across multiple reads", {
 })
 
 test_that("sse always interprets data as UTF-8", {
-  # skip_on_covr()
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     res$send_chunk("data: \xE3\x81\x82\r\n\r\n")
   })
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
 
   withr::with_locale(c(LC_CTYPE = "C"), {
     # Non-blocking returns NULL until data is ready
@@ -256,15 +227,11 @@ test_that("sse always interprets data as UTF-8", {
 })
 
 test_that("streaming size limits enforced", {
-  app <- webfakes::new_app()
-
-  app$get("/events", function(req, res) {
+  req <- local_app_request(function(req, res) {
     data_size <- 1000
     data <- paste(rep_len("0", data_size), collapse = "")
     res$send_chunk(data)
   })
-  server <- webfakes::local_app_process(app)
-  req <- request(server$url("/events"))
 
   resp1 <- req_perform_connection(req, blocking = FALSE)
   withr::defer(close(resp1))