Improve try_again()

* Simplify implemenation
* Improve docs
* First argument is now the number of retries, not tries

Fixes #2050

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `try_again()` is now publicised. The first argument is now the number of retries, not tries (#2050).
 * `vignette("custom-expectations)` has been overhauled to make it much clearer how to create high-quality expectations (#2113, #2132, #2072).
 * `expect_snapshot()` and friends will now fail when creating a new snapshot on CI. This is usually a signal that you've forgotten to run it locally before committing (#1461).
 * `expect_snapshot_value()` can now handle expressions that generate `-` (#1678) or zero length atomic vectors (#2042).

R/try-again.R

@@ -1,48 +1,38 @@
-#' Try evaluating an expressing multiple times until it succeeds.
+#' Try evaluating an expressing multiple times until it succeeds
 #'
-#' @param times Maximum number of attempts.
-#' @param code Code to evaluate
-#' @keywords internal
+#' If you have a flaky test, you can use `try_again()` to run it a few times
+#' until it succeeds. In most cases, you are better fixing the underlying
+#' cause of the flakeyness, but sometimes that's not possible.
+#'
+#' @param times Number of times to retry.
+#' @param code Code to evaluate.
 #' @export
 #' @examples
-#' third_try <- local({
-#'   i <- 3
-#'   function() {
-#'     i <<- i - 1
-#'     if (i > 0) fail(paste0("i is ", i))
-#'   }
-#' })
-#' try_again(3, third_try())
+#' usually_return_1 <- function(i) {
+#'   if (runif(1) < 0.1) 0 else 1
+#' }
+#'
+#' \dontrun{
+#' # 10% chance of failure:
+#' expect_equal(usually_return_1(), 1)
+#'
+#' # 1% chance of failure:
+#' try_again(3, expect_equal(usually_return_1(), 1))
+#' }
 try_again <- function(times, code) {
-  while (times > 0) {
-    e <- tryCatch(
-      withCallingHandlers(
-        {
-          code
-          NULL
-        },
-        warning = function(e) {
-          if (
-            identical(e$message, "restarting interrupted promise evaluation")
-          ) {
-            tryInvokeRestart("muffleWarning")
-          }
-        }
-      ),
-      expectation_failure = function(e) {
-        e
-      },
-      error = function(e) {
-        e
-      }
-    )
+  check_number_whole(times, min = 1)
 
-    if (is.null(e)) {
-      return(invisible(TRUE))
-    }
+  code <- enquo(code)
 
-    times <- times - 1L
+  i <- 1
+  while (i <= times) {
+    tryCatch(
+      return(eval(get_expr(code), get_env(code))),
+      expectation_failure = function(cnd) NULL
+    )
+    cli::cli_inform(c(i = "Expectation failed; trying again ({i})..."))
+    i <- i + 1
   }
 
-  exp_signal(e)
+  eval(get_expr(code), get_env(code))
 }

_pkgdown.yml

@@ -41,6 +41,10 @@ reference:
   - expect_invisible
   - expect_output
   - expect_silent
+
+- subtitle: Helpers
+  contents:
+  - try_again
   - local_reproducible_output
 
 - title: Snapshot testing

man/try_again.Rd

@@ -0,0 +1,21 @@
+# tries multiple times
+
+    Code
+      result <- try_again(3, third_try())
+    Message
+      i Expectation failed; trying again (1)...
+      i Expectation failed; trying again (2)...
+
+---
+
+    Code
+      try_again(1, third_try())
+    Message
+      i Expectation failed; trying again (1)...
+    Condition
+      Error:
+      ! `i` (`actual`) is not equal to 0 (`expected`).
+      
+        `actual`: 1.0
+      `expected`: 0.0
+

tests/testthat/_snaps/try-again.md

@@ -1,17 +1,15 @@
 succeed_after <- function(i) {
   function() {
     i <<- i - 1
-    if (i > 0) {
-      return(fail(paste0("i is ", i)))
-    }
-    pass(NULL)
+    expect_equal(i, 0)
   }
 }
 
 test_that("tries multiple times", {
   third_try <- succeed_after(3)
-  expect_true(try_again(3, third_try()))
+  expect_snapshot(result <- try_again(3, third_try()))
+  expect_equal(result, 0)
 
   third_try <- succeed_after(3)
-  expect_failure(try_again(2, third_try()), "i is 1")
+  expect_snapshot(try_again(1, third_try()), error = TRUE)
 })