From 315b2fa4f16bcc0d259980ee7d0372489b855d23 Mon Sep 17 00:00:00 2001
From: Maximilian Held <info@maxheld.de>
Date: Wed, 8 Dec 2021 22:09:41 +0100
Subject: [PATCH] add test helpers for async

---
 DESCRIPTION            |  4 +++-
 R/test-helpers.R       | 43 ++++++++++++++++++++++++++++++++++++++++++
 tests/testthat/setup.R |  2 ++
 3 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 8cbf4d1d..82babb3e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -97,7 +97,9 @@ Suggests:
     htmltools,
     knitr,
     pkgdown,
-    downlit
+    downlit,
+    remotes,
+    usethis
 URL: https://subugoe.github.io/metacheck, https://github.com/subugoe/metacheck
 BugReports: https://github.com/subugoe/metacheck/issues
 Remotes: 
diff --git a/R/test-helpers.R b/R/test-helpers.R
index 6b66c406..31c5ef31 100644
--- a/R/test-helpers.R
+++ b/R/test-helpers.R
@@ -3,6 +3,49 @@
 #' @noRd
 throwaway <- "whatever@mailinator.com"
 
+#' Install metacheck in temp library path
+#' Necessary for any testing in testthat with [future::multisession()]
+#' @noRd
+local_mc <- function(env = parent.frame()) {
+  withr::local_temp_libpaths(.local_envir = env)
+  remotes::install_local(
+    path = usethis::proj_get(),
+    dependencies = FALSE,
+    upgrade = FALSE,
+    force = TRUE
+  )
+}
+
+#' Temporarily set future plan
+#' @inheritParams future::strategy
+#' @noRd
+local_strategy <- function(strategy, env = parent.frame()) {
+  old_plan <- future::plan(strategy = strategy)
+  withr::defer(future::plan(old_plan), env = env)
+}
+
+#' Future strategies to be tested
+#' @noRd
+strategies <- list(
+  sequential = future::sequential,
+  multicore = future::multicore,
+  multisession = future::multisession
+)
+
+#' Skipping unsupported strategies
+skip_if_strategy_unsupported <- function(strategy_name = names(strategies)) {
+  strategy_name <- rlang::arg_match(strategy_name)
+  if (strategy_name == "multicore" && !future::supportsMulticore()) {
+    return(testthat::skip("Multicore is not supported"))
+  }
+  if (strategy_name == "multisession" && testthat::is_parallel()) {
+    return(testthat::skip(
+      "Multisession futures cannot be tested inside parallel tests."
+    ))
+  }
+  invisible(TRUE)
+}
+
 #' used often b/c plain json doesn't cover complex objects
 #' @noRd
 expect_snapshot_value2 <- purrr::partial(
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index e69de29b..0d11c278 100644
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -0,0 +1,2 @@
+# multisession futures need locally installed metacheck
+local_mc(env = testthat::teardown_env())