diff --git a/R/localRedirect.R b/R/localRedirect.R index 80ae6d9..9e6bdd2 100644 --- a/R/localRedirect.R +++ b/R/localRedirect.R @@ -10,6 +10,8 @@ #' a potential later implementation of subtype redirections. #' @param ... Additional arguments, passed on to source-specific inject function if it exists #' @param target Path to the new source folder, NULL to remove the redirection +#' @param .local The scope of the redirection, passed on to setConfig. Defaults to the current function. +#' Set to FALSE for a permanent global redirection. #' @return Invisibly, a list of all redirections where names are types and #' values are the paths these types are redirected to. #' @author Pascal Sauer @@ -26,7 +28,7 @@ #' readSource("Tau") #' } #' @export -localRedirect <- function(type, subtype = NULL, ..., target) { +localRedirect <- function(type, subtype = NULL, ..., target, .local = parent.frame()) { # Redirecting only specific subtypes is not supported to avoid tricky cases # where the subtype is ignored (search for "getSourceFolder\(.*subtype = NULL\)"). @@ -39,7 +41,6 @@ localRedirect <- function(type, subtype = NULL, ..., target) { redirections <- getConfig("redirections") redirections[[type]] <- target - # TODO allow other scopes, e.g. global or parent.frame(2) - setConfig(redirections = redirections, .local = parent.frame()) + setConfig(redirections = redirections, .local = .local) return(invisible(redirections)) } diff --git a/tests/testthat/test-localRedirect.R b/tests/testthat/test-localRedirect.R index 6370acd..a53dded 100644 --- a/tests/testthat/test-localRedirect.R +++ b/tests/testthat/test-localRedirect.R @@ -30,3 +30,17 @@ test_that("localRedirect works", { localRedirect("Example", target = "Example2") expect_identical(as.vector(readSource("Example")), 456) }) + +test_that("scope for localRedirect can be set", { + localConfig(redirections = list()) + withr::local_dir(withr::local_tempdir()) + dir.create("tau2") + dir.create("tau3") + + f1 <- function() { + localRedirect("tau", target = "tau2") + expect_identical(getConfig("redirections"), list(tau = normalizePath("tau2"))) + } + f() + expect_identical(getConfig("redirections"), list()) +})