tests/testthat/test-outpack-helpers.R

In orderly: Lightweight Reproducible Reporting

test_that("can copy files from outpack", {
  root <- create_temporary_root(use_file_store = TRUE)
  id <- create_random_packet(root)
  dst <- temp_file()
  res <-  orderly_copy_files(
    id, files = c("incoming.rds" = "data.rds"), dest = dst, root = root)
  expect_equal(dir(dst), "incoming.rds")
  expect_identical(
    readRDS(file.path(dst, "incoming.rds")),
    readRDS(file.path(root$path, "archive", "data", id, "data.rds")))
  expect_true(fs::file_access(file.path(dst, "incoming.rds"), "write"))
})


test_that("can copy files from location, using store", {
  here <- create_temporary_root(use_file_store = TRUE)
  there <- create_temporary_root(use_file_store = TRUE)
  orderly_location_add_path("there", path = there$path, root = here)
  id <- create_random_packet(there)

  tmp <- withr::local_tempdir()
  expect_error(
    orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp,
                       root = here),
    "Packet '.+' not found in outpack index")
  orderly_location_fetch_metadata(root = here)

  expect_error(
    orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp,
                       root = here),
    "Unable to copy files, as they are not available locally")

  suppressMessages(
    orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp,
                       allow_remote = TRUE, root = here))
  expect_equal(dir(tmp), "data.rds")

  meta <- orderly_metadata(id, root = there)
  hash <- meta$files$hash[meta$files$path == "data.rds"]
  expect_equal(hash_file(file.path(tmp, "data.rds"), "sha256"), hash)
  expect_equal(here$files$list(), hash)
})


test_that("can copy files from location, using archive", {
  here <- create_temporary_root(use_file_store = FALSE)
  there <- create_temporary_root(use_file_store = TRUE)
  orderly_location_add_path("there", path = there$path, root = here)
  id <- create_random_packet(there)

  tmp <- withr::local_tempdir()
  orderly_location_fetch_metadata(root = here)
  expect_error(
    orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp,
                       root = here),
    "Unable to copy files, as they are not available locally")

  suppressMessages(
    orderly_copy_files(id, files = c("data.rds" = "data.rds"), dest = tmp,
                       allow_remote = TRUE, root = here))
  expect_equal(dir(tmp), "data.rds")

  meta <- orderly_metadata(id, there)
  hash <- meta$files$hash[meta$files$path == "data.rds"]
  expect_equal(hash_file(file.path(tmp, "data.rds"), "sha256"), hash)
})


test_that("can interpolate filenames in copy", {
  root <- create_temporary_root(use_file_store = TRUE)
  id <- create_random_packet(root)
  dst <- temp_file()
  ## Some bindings to force lookup:
  path <- "a"
  file <- "b"
  suppressMessages(
    orderly_copy_files(id, files = c("${path}/${file}.rds" = "data.rds"),
                       dest = dst, root = root))
  expect_equal(dir(dst), "a")
  expect_equal(dir(file.path(dst, "a")), "b.rds")
  expect_identical(
    readRDS(file.path(dst, "a", "b.rds")),
    readRDS(file.path(root$path, "archive", "data", id, "data.rds")))
})


test_that("require a single id for search", {
  dst <- withr::local_tempdir()
  root <- create_temporary_root(use_file_store = TRUE)
  ids <- replicate(3, outpack_id())
  expect_error(
    orderly_copy_files(ids, files = c(here = "there"), dest = dst, root = root),
    "Expected a length 1 value for 'expr' if id (not 3)",
    fixed = TRUE)
  expect_error(
    orderly_copy_files(character(), files = c(here = "there"), dest = dst,
                       root = root),
    "Expected a length 1 value for 'expr' if id (not 0)",
    fixed = TRUE)
})


test_that("require a single id for search", {
  dst <- withr::local_tempdir()
  root <- create_temporary_root(use_file_store = TRUE)
  ids <- vcapply(1:3, function(i) create_random_packet(root))
  err <- expect_error(
    orderly_copy_files(name = "data", files = c(here = "there"),
                       dest = dst, root = root),
    "Query returned 3 results, expected a single result")
  expect_equal(err$body, c(i = "Did you forget latest()?"))

  err <- expect_error(
    orderly_copy_files(name = "missing", files = c(here = "there"),
                       dest = dst, root = root),
    "Query returned 0 results")
  expect_equal(err$body,
               c(i = "See 'rlang::last_error()$explanation' for details"))
  expect_equal(err$explanation,
               orderly_query_explain(NULL, name = "missing", root = root))
})


test_that("good error message if file not found in packet", {
  dst <- withr::local_tempdir()
  root <- create_temporary_root(use_file_store = TRUE)

  src <- fs::dir_create(file.path(dst, "src"))
  file.create(file.path(src, c("a.txt", "b.txt", "c.txt")))
  p <- outpack_packet_start_quietly(src, "data", root = root)
  outpack_packet_end_quietly(p)

  id <- p$id

  expect_null(validate_packet_has_file(root, id, "a.txt"))

  err <- expect_error(
    validate_packet_has_file(root, id, "a.TXT"),
    "Packet '.+' does not contain the requested path\\s*'a.TXT'")
  expect_equal(
    err$body,
    c(i = "For 'a.TXT' did you mean 'a.txt'",
      i = "Remember that all orderly paths are case sensitive"))

  err <- expect_error(
    validate_packet_has_file(root, id, "d.txt"),
    "Packet '.+' does not contain the requested path\\s*'d.txt'")
  expect_equal(
    err$body,
    c(i = "For 'd.txt' did you mean 'a.txt', 'b.txt' or 'c.txt'"))

  err <- expect_error(
    validate_packet_has_file(root, id, c("a.txt", "a.TXT", "d.txt")),
    "Packet '.+' does not contain the requested paths\\s*'a.TXT' and 'd.txt'")
  expect_equal(
    err$body,
    c(i = "For 'a.TXT' did you mean 'a.txt'",
      i = "For 'd.txt' did you mean 'a.txt', 'b.txt' or 'c.txt'",
      i = "Remember that all orderly paths are case sensitive"))
})


test_that("Can overwrite when copying files from packet", {
  root <- create_temporary_root(use_file_store = TRUE)

  id1 <- create_random_packet(root)
  id2 <- create_random_packet(root)

  # Just a bit of a sanity check. The two packets are random, so we'd expect
  # them to have different contents.
  expect_false(identical(
    readRDS(file.path(root$path, "archive", "data", id1, "data.rds")),
    readRDS(file.path(root$path, "archive", "data", id2, "data.rds"))))

  dst <- temp_file()

  suppressMessages(
    orderly_copy_files(id1, files = "data.rds", dest = dst, root = root))

  expect_identical(
    readRDS(file.path(dst, "data.rds")),
    readRDS(file.path(root$path, "archive", "data", id1, "data.rds")))

  suppressMessages(
    orderly_copy_files(id2, files = "data.rds", dest = dst, root = root))

  expect_identical(
    readRDS(file.path(dst, "data.rds")),
    readRDS(file.path(root$path, "archive", "data", id2, "data.rds")))
})


test_that("can copy complete directory", {
  path <- test_prepare_orderly_example("directories")
  envir <- new.env()
  id <- orderly_run_quietly("directories", root = path, envir = envir)
  meta <- orderly_metadata(id, root = path)

  dst <- temp_file()
  res <-  orderly_copy_files(
    id, files = "./", dest = dst, root = path)

  expect_setequal(res$files$here, meta$files$path)
  expect_equal(res$files$here, res$files$there)
  expect_true(all(file.exists(file.path(dst, res$files$here))))
  expect_setequal(list.files(dst, recursive = TRUE), res$files$here)
})


test_that("allow duplicate files that point to the same place", {
  path <- test_prepare_orderly_example("directories")
  envir <- new.env()
  id <- orderly_run_quietly("directories", root = path, envir = envir)
  meta <- orderly_metadata(id, root = path)

  dst <- temp_file()

  ## This does not make a lot of sense, but is equivalent to what
  ## happens where a packet contains duplicate filenames
  res <-  orderly_copy_files(
    id, files = c("./", "data/a.csv"), dest = dst, root = path)

  expect_setequal(res$files$here, meta$files$path)
  expect_equal(nrow(res$files), nrow(meta$files))
  expect_equal(res$files$here, res$files$there)
  expect_true(all(file.exists(file.path(dst, res$files$here))))
  expect_setequal(list.files(dst, recursive = TRUE), res$files$here)
})


test_that("disallow duplicate files that point to different places", {
  path <- test_prepare_orderly_example("directories")
  envir <- new.env()
  id <- orderly_run_quietly("directories", root = path, envir = envir)
  meta <- orderly_metadata(id, root = path)

  dst <- temp_file()

  expect_error(
    orderly_copy_files(
      id, files = c("./", "data/b.csv" = "data/a.csv"),
      dest = dst, root = path),
    "Directory expansion would result in overwritten files")
})

test_that("can copy an empty list of files", {
  root <- create_temporary_root()
  id <- create_random_packet(root)

  dst <- withr::local_tempdir()

  res <- orderly_copy_files(id, files = character(0), dest = dst, root = root)
  expect_equal(res$files, data_frame(here = character(0), there = character(0)))
})