Skip to content

Commit

Permalink
symlink test
Browse files Browse the repository at this point in the history
  • Loading branch information
@pascal-sauer
pascal-sauer committed Jan 31, 2024
1 parent 453c733 commit 6c08316
Show file tree
Hide file tree
Showing 2 changed files with 151 additions and 17 deletions.
60 changes: 50 additions & 10 deletions R/redirectSource.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,14 +5,13 @@
#' example for more details.
#'
#' @param type Dataset name, e.g. "Tau" for \code{\link{readTau}}
#' @param subtype Not supported for now, must be NULL. This is here to simplify
#' a potential later implementation of subtype redirections.
#' @param target Either path to the new source folder that should be used instead of the default,
#' or a list/vector of paths to files which are then symlinked into a temporary folder that is then
#' used as target folder, or NULL to remove the redirection
#' @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 an environment for more control or 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.
#' @return Invisibly, the source folder that is now used for the given type
#' @author Pascal Sauer
#' @examples \dontrun{
#' f <- function() {
Expand All @@ -27,12 +26,11 @@
#' readSource("Tau")
#' }
#' @export
redirectSource <- function(type, subtype = NULL, ..., target, .local = TRUE) {
redirectSource <- function(type, target, ..., .local = TRUE) {
# Redirecting only specific subtypes is not supported to avoid tricky cases
# where the subtype is ignored (search for "getSourceFolder\(.*subtype = NULL\)").
stopifnot(is.null(subtype))

# TODO call source-specific inject function if it exists
# TODO call source-specific redirect function if it exists

if (is.environment(.local)) {
.localEnvir <- .local
Expand All @@ -43,10 +41,52 @@ redirectSource <- function(type, subtype = NULL, ..., target, .local = TRUE) {
}

if (!is.null(target)) {
preservedNames <- names(target)
target <- normalizePath(target, mustWork = TRUE)
names(target) <- preservedNames
if (length(target) >= 2 || !dir.exists(target)) {
# redirect to files
tempDir <- withr::local_tempdir(.local_envir = .localEnvir)
file.symlink(target, file.path(tempDir, basename(target)))
if (is.null(names(target))) {
names(target) <- basename(target)
} else {
# append basename to target path if it ends with "/"
i <- endsWith(names(target), "/")
names(target)[i] <- paste0(names(target)[i], basename(target[i]))

for (p in file.path(tempDir, names(target))) {
if (!dir.exists(dirname(p))) {
dir.create(dirname(p), recursive = TRUE)
}
}
}
file.symlink(target, file.path(tempDir, names(target)))

# symlink all other files in original source folder
# TODO test thoroughly
parentFolders <- function(path, collected = NULL) {
if (path == ".") {
return(collected)
}
return(parentFolders(dirname(path), c(path, collected)))
}

dontlink <- lapply(names(target), parentFolders) # find all parent folders
dontlink <- unique(do.call(c, dontlink)) # flatten and remove duplicates

sourceFolder <- getSourceFolder(type, subtype = NULL)
withr::with_dir(sourceFolder, {
dirs <- Filter(dir.exists, dontlink)
linkThese <- lapply(c(".", dirs), dir, all.files = TRUE, no.. = TRUE, full.names = TRUE)
})
linkThese <- do.call(c, linkThese)
linkThese <- sub("^\\./", "", linkThese)
linkThese <- setdiff(linkThese, dontlink)
if (length(linkThese) > 0) {
file.symlink(file.path(sourceFolder, linkThese),
file.path(tempDir, linkThese))
}

target <- tempDir
}
# paths inside the source folder use the fileHashCache system, see getHashCacheName,
Expand All @@ -57,5 +97,5 @@ redirectSource <- function(type, subtype = NULL, ..., target, .local = TRUE) {
redirections <- getConfig("redirections")
redirections[[type]] <- target
setConfig(redirections = redirections, .local = .localEnvir)
return(invisible(redirections))
return(invisible(target))
}
108 changes: 101 additions & 7 deletions tests/testthat/test-redirectSource.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,13 @@ test_that("redirectSource writes to config as intended", {
dir.create("tau2")
dir.create("tau3")
dir.create("example2")
expect_identical(redirectSource("tau", target = "tau2"), list(tau = normalizePath("tau2")))
expect_identical(redirectSource("tau", target = "tau3"), list(tau = normalizePath("tau3")))
expect_identical(redirectSource("example", target = "example2"),
expect_identical(redirectSource("tau", target = "tau2"), normalizePath("tau2"))
expect_identical(redirectSource("tau", target = "tau3"), normalizePath("tau3"))
expect_identical(redirectSource("example", target = "example2"), normalizePath("example2"))
expect_identical(getConfig("redirections"),
list(tau = normalizePath("tau3"), example = normalizePath("example2")))
expect_identical(redirectSource("tau", target = NULL), list(example = normalizePath("example2")))
expect_null(redirectSource("tau", target = NULL))
expect_identical(getConfig("redirections"), list(example = normalizePath("example2")))
})

test_that("redirectSource works", {
Expand All @@ -18,6 +20,8 @@ test_that("redirectSource works", {
writeLines("123", file.path(getConfig("sourcefolder"), "Example", "Example.txt"))
target <- file.path(withr::local_tempdir(), "Example.txt")
writeLines("456", target)
target2 <- file.path(withr::local_tempdir(), "Example.txt")
writeLines("456", target2)

readExample <- function() {
return(as.magpie(as.numeric(readLines("Example.txt"))))
Expand All @@ -38,12 +42,37 @@ test_that("redirectSource works", {
expect_identical(as.vector(readSource("Example")), 123)
expect_identical(fingerprint("readExample", packages = "madrat"), fp)

redirectSource("Example", target = target2)
expect_identical(as.vector(readSource("Example")), 456)
expect_identical(fingerprint("readExample", packages = "madrat"), nfp)

# ensure same fingerprint after redirecting to the same target again
redirectSource("Example", target = target)
expect_identical(as.vector(readSource("Example")), 456)
expect_identical(fingerprint("readExample", packages = "madrat"), nfp)
})

test_that("redirectSource symlinks other files", {
sourceFolder <- withr::local_tempdir()
localConfig(sourcefolder = sourceFolder)
dir.create(file.path(sourceFolder, "Example"))
writeLines("123", file.path(sourceFolder, "Example", "Example.txt"))
writeLines("789", file.path(sourceFolder, "Example", "Example2.txt"))
target <- file.path(withr::local_tempdir(), "Example.txt")
writeLines("456", target)

readExample <- function() {
return(as.magpie(as.numeric(paste0(readLines("Example.txt"), readLines("Example2.txt")))))
}
globalassign("readExample")

expect_identical(as.vector(readSource("Example")), 123789)
redirectSource("Example", target = target)
expect_identical(as.vector(readSource("Example")), 456789)
# TODO redirectSource("Example", target = target, bare = TRUE)
# expect_error(readSource("Example"), "cannot open file 'Example2.txt': No such file or directory", fixed = TRUE)
})

test_that("scope for redirectSource can be set", {
localConfig(redirections = list())
withr::local_dir(withr::local_tempdir())
Expand All @@ -66,7 +95,8 @@ test_that("scope for redirectSource can be set", {
})

test_that("redirect target can be files", {
localConfig(redirections = list())
localConfig(redirections = list(), sourcefolder = withr::local_tempdir())
dir.create(getSourceFolder("Example", subtype = NULL))
withr::local_dir(withr::local_tempdir())
writeLines("123", "Example.txt")
writeLines("456", "Example2.txt")
Expand All @@ -79,7 +109,7 @@ test_that("redirect target can be files", {
redirectSource("Example", target = c("Example.txt", "Example2.txt"), .local = .local)
sourceFolder <- normalizePath(getSourceFolder("Example", subtype = NULL))
expect_true(sourceFolder != normalizePath("."))
expect_true(setequal(dir(sourceFolder), c("Example.txt", "Example2.txt")))
expect_setequal(dir(sourceFolder), c("Example.txt", "Example2.txt"))
expect_identical(as.vector(readSource("Example")), 123456)
return(sourceFolder)
}
Expand All @@ -100,7 +130,21 @@ test_that("redirect target can be files", {
redirectSource("Example", target = "Example.txt")
sourceFolder <- normalizePath(getSourceFolder("Example", subtype = NULL))
expect_true(sourceFolder != normalizePath("."))
expect_identical(dir(sourceFolder), "Example.txt")
expect_setequal(dir(sourceFolder), c("Example.txt", "Example2.txt"))
expect_identical(as.vector(readSource("Example")), 123)

readExample <- function() {
return(as.magpie(as.numeric(paste0(readLines("some/subfolder/Example.txt")))))
}
globalassign("readExample")

redirectSource("Example", target = c(`some/subfolder/Example.txt` = "Example.txt"))
sourceFolder <- normalizePath(getSourceFolder("Example", subtype = NULL))
expect_true(sourceFolder != normalizePath("."))
expect_setequal(dir(sourceFolder), c("some", "Example.txt", "Example2.txt"))
expect_identical(as.vector(readSource("Example")), 123)

redirectSource("Example", target = c("some/subfolder/" = "Example.txt"))
expect_identical(as.vector(readSource("Example")), 123)
})

Expand Down Expand Up @@ -129,3 +173,53 @@ test_that("caching works with redirectSource", {
redirectSource("Example", target = target)
expect_message(readSource("Example"), "loading cache")
})

test_that("redirectSource symlinks all other files", {
localConfig(sourcefolder = withr::local_tempdir(), cachefolder = withr::local_tempdir())
sourceFolder <- getSourceFolder("Example", subtype = NULL)
dir.create(sourceFolder)
for (p in c("A/a.txt",
"B/B1/b.txt", "B/B2/b.txt", "B/B2/.hidden", "B/B2/B21/b.txt",
"C/c.txt",
"x.txt")) {
dir.create(file.path(sourceFolder, dirname(p)), showWarnings = FALSE, recursive = TRUE)
writeLines(p, file.path(sourceFolder, p))
}

target <- file.path(withr::local_tempdir(), "redirected.txt")
writeLines("redirected", target)

readExample <- function() {
x <- as.magpie(1)
attr(x, "content") <- readLines("x.txt")
return(x)
}
globalassign("readExample")
expect_identical(attr(readSource("Example"), "content"), "x.txt")
redirectedSourceFolder <- redirectSource("Example", target = c(`x.txt` = target))
expect_identical(attr(readSource("Example"), "content"), "redirected")
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "x.txt")), target)
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "A")), file.path(sourceFolder, "A"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B")), file.path(sourceFolder, "B"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "C")), file.path(sourceFolder, "C"))

readExample <- function() {
x <- as.magpie(1)
attr(x, "content") <- readLines("B/B2/b.txt")
return(x)
}
globalassign("readExample")
redirectSource("Example", target = NULL)
expect_identical(attr(readSource("Example"), "content"), "B/B2/b.txt")
redirectedSourceFolder <- redirectSource("Example", target = c(`B/B2/b.txt` = target))
expect_identical(attr(readSource("Example"), "content"), "redirected")
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "x.txt")), file.path(sourceFolder, "x.txt"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "A")), file.path(sourceFolder, "A"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B")), "")
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B/B1")), file.path(sourceFolder, "B/B1"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B/B2/b.txt")), target)
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B/B2/.hidden")),
file.path(sourceFolder, "B/B2/.hidden"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "B/B2/B21")), file.path(sourceFolder, "B/B2/B21"))
expect_identical(Sys.readlink(file.path(redirectedSourceFolder, "C")), file.path(sourceFolder, "C"))
})

0 comments on commit 6c08316

Please sign in to comment.