test_that("Can run a basic packet", { path_src <- temp_file() fs::dir_create(path_src) writeLines(c( "d <- read.csv('data.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src, "data.csv"), row.names = FALSE) root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path p <- outpack_packet_start_quietly(path_src, "example", root = root) expect_s3_class(p, "outpack_packet") expect_null(p$complete) outpack_packet_run(p, "script.R") expect_true(file.exists(file.path(path_src, "myplot.png"))) outpack_packet_end_quietly(p) expect_true(p$complete) index <- root$index$data() expect_length(index$metadata, 1) id <- p$id path_metadata <- file.path(path, ".outpack", "metadata", id) expect_true(file.exists(path_metadata)) if (requireNamespace("jsonvalidate", quietly = TRUE)) { expect_true(load_schema("outpack/metadata.json")$validate(path_metadata)) } path_location <- file.path(path, ".outpack", "location", "local", id) expect_true(file.exists(path_location)) if (requireNamespace("jsonvalidate", quietly = TRUE)) { expect_true(load_schema("outpack/location.json")$validate(path_location)) } meta <- outpack_metadata_load(file(path_metadata), NULL) ## The index metadata is a subset of the full set: expect_mapequal( index$metadata[[id]], meta[c("name", "id", "parameters", "files", "time", "depends")]) expect_setequal( names(meta), c("schema_version", "name", "id", "time", "parameters", "files", "depends", "custom", "git")) expect_equal(meta$schema_version, outpack_schema_version()) expect_equal(meta$name, "example") expect_equal(meta$id, id) expect_null(meta$parameters) expect_equal(meta$depends, data_frame(packet = character(), query = character(), files = I(list()))) expect_setequal(meta$files$path, c("data.csv", "myplot.png", "script.R")) expect_equal(meta$files$size, file.size(file.path(path_src, meta$files$path))) expect_equal(meta$files$hash, hash_files(file.path(path_src, meta$files$path))) expect_null(meta$custom) expect_null(meta$git) ## Copy of the files in human readable archive: expect_true(all(file.exists( file.path(path, "archive", "example", id, meta$files$path)))) expect_equal( hash_files(file.path(path, "archive", "example", id, meta$files$path)), meta$files$hash) ## Copy of the files in the file store: expect_setequal(root$files$list(), meta$files$hash) expect_equal(index$unpacked, id) ## Easily retrieve metadata from root: expect_equal(outpack_metadata_core(id, root), index$metadata[[id]]) }) test_that("Can handle dependencies", { ## A simple example where we run something. path_src1 <- temp_file() fs::dir_create(path_src1) writeLines(c( "d <- read.csv('data.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src1, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src1, "data.csv"), row.names = FALSE) path_src2 <- temp_file() fs::dir_create(path_src2) writeLines(c( "d <- read.csv('incoming.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src2, "script.R")) root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) id1 <- p1$id outpack_packet_run(p1, "script.R") outpack_packet_end_quietly(p1) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) id2 <- p2$id outpack_packet_use_dependency(p2, id1, c("incoming.csv" = "data.csv")) outpack_packet_run(p2, "script.R") outpack_packet_end_quietly(p2) meta <- orderly_metadata(id2, root = path) path_metadata <- file.path(path, ".outpack", "metadata", id2) expect_true(file.exists(path_metadata)) if (requireNamespace("jsonvalidate", quietly = TRUE)) { expect_true(load_schema("outpack/metadata.json")$validate(path_metadata)) } expect_equal( meta$depends, data_frame( packet = id1, query = sprintf('single(id == "%s")', id1), files = I(list(data_frame(here = "incoming.csv", there = "data.csv"))))) }) test_that("Can't add a packet twice", { ## A simple example where we run something. path_src <- temp_file() fs::dir_create(path_src) root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_end_quietly(p) id <- p$id json <- read_string(file.path(path, ".outpack", "metadata", id)) class(json) <- "json" expect_error( outpack_insert_packet(path_src, json, root), "'.+' has already been added for 'local'") }) test_that("Can't use nonexistant id as dependency", { path_src <- temp_file() fs::dir_create(path_src) root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path p1 <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_end_quietly(p1) p2 <- outpack_packet_start_quietly(path_src, "example", root = root) expect_error( outpack_packet_use_dependency(p2, p1$id, c("a" = "b")), sprintf("Packet '%s' does not contain the requested path", p1$id)) suppressMessages(outpack_packet_cancel(p2)) }) test_that("Can't use file that does not exist from dependency", { path_src1 <- temp_file() fs::dir_create(path_src1) path_src2 <- temp_file() fs::dir_create(path_src2) root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) outpack_packet_end_quietly(p1) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) expect_error( outpack_packet_use_dependency(p2, p1$id, c("incoming.csv" = "data.csv")), "Packet '.+' does not contain the requested path") }) test_that("Can use dependency from outpack without file store", { path_src1 <- temp_file() fs::dir_create(path_src1) writeLines(c( "d <- read.csv('data.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src1, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src1, "data.csv"), row.names = FALSE) path_src2 <- temp_file() fs::dir_create(path_src2) writeLines(c( "d <- read.csv('incoming.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src2, "script.R")) root <- create_temporary_root(path_archive = "archive", use_file_store = FALSE) path <- root$path p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) id1 <- p1$id outpack_packet_run(p1, "script.R") outpack_packet_end_quietly(p1) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) id2 <- p2$id outpack_packet_use_dependency(p2, id1, c("incoming.csv" = "data.csv")) outpack_packet_run(p2, "script.R") outpack_packet_end_quietly(p2) meta <- orderly_metadata(id2, root = path) expect_equal( meta$depends, data_frame( packet = id1, query = sprintf('single(id == "%s")', id1), files = I(list(data_frame(here = "incoming.csv", there = "data.csv"))))) }) test_that("validate dependencies from archive", { path_src1 <- temp_file() fs::dir_create(path_src1) writeLines(c( "d <- read.csv('data.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src1, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src1, "data.csv"), row.names = FALSE) path_src2 <- temp_file() fs::dir_create(path_src2) writeLines(c( "d <- read.csv('incoming.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src2, "script.R")) root <- create_temporary_root(path_archive = "archive", use_file_store = FALSE) path <- root$path p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) id1 <- p1$id outpack_packet_run(p1, "script.R") outpack_packet_end_quietly(p1) ## Corrupt the file here. forcibly_truncate_file(file.path(root$path, "archive", "a", id1, "data.csv")) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) id2 <- p2$id expect_error( outpack_packet_use_dependency(p2, id1, c("incoming.csv" = "data.csv")), "Hash of '.+' does not match") }) test_that("Can add additional data", { tmp <- temp_file() root <- create_temporary_root() src <- fs::dir_create(file.path(tmp, "src")) saveRDS(runif(10), file.path(src, "data.rds")) p <- outpack_packet_start_quietly(src, "example", root = root) custom <- '{"a": 1, "b": 2}' outpack_packet_add_custom(p, "potato", custom) outpack_packet_end_quietly(p) meta <- orderly_metadata(p$id, root = root) expect_equal(meta$custom, list(potato = list(a = 1, b = 2))) }) test_that("Can add multiple copies of extra data", { tmp <- temp_file() root <- create_temporary_root() src <- fs::dir_create(file.path(tmp, "src")) saveRDS(runif(10), file.path(src, "data.rds")) p <- outpack_packet_start_quietly(src, "example", root = root) outpack_packet_add_custom(p, "app1", '{"a": 1, "b": 2}') outpack_packet_add_custom(p, "app2", '{"c": [1, 2, 3]}') outpack_packet_end_quietly(p) path_metadata <- file.path(root$path, ".outpack", "metadata", p$id) meta <- outpack_metadata_load(file(path_metadata), NULL) expect_equal(meta$custom, list(app1 = list(a = 1, b = 2), app2 = list(c = list(1, 2, 3)))) }) test_that("Can't add custom data for same app twice", { tmp <- temp_file() root <- create_temporary_root() src <- fs::dir_create(file.path(tmp, "src")) saveRDS(runif(10), file.path(src, "data.rds")) p <- outpack_packet_start_quietly(src, "example", root = root) outpack_packet_add_custom(p, "app1", '{"a": 1, "b": 2}') outpack_packet_add_custom(p, "app2", '{"a": 1, "b": 2}') expect_error( outpack_packet_add_custom(p, "app1", '{"c": [1, 2, 3]}'), "metadata for 'app1' has already been added for this packet") expect_error( outpack_packet_add_custom(p, "app2", '{"c": [1, 2, 3]}'), "metadata for 'app2' has already been added for this packet") }) test_that("Can report nicely about json syntax errors", { tmp <- temp_file() root <- create_temporary_root() src <- fs::dir_create(file.path(tmp, "src")) saveRDS(runif(10), file.path(src, "data.rds")) p <- outpack_packet_start_quietly(src, "example", root = root) expect_error( outpack_packet_add_custom(p, "app1", '{"a": 1, "b": 2'), "Error while reading custom metadata") }) test_that("pre-prepared id can be used to start packet", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) id <- outpack_id() path_src <- temp_file() fs::dir_create(path_src) p <- outpack_packet_start_quietly(path_src, "example", id = id, root = root) expect_equal(p$id, id) outpack_packet_end_quietly(p) index <- root$index$data() expect_equal(names(index$metadata), id) }) test_that("Can hash files on startup", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- temp_file() fs::dir_create(path_src) path_src <- temp_file() fs::dir_create(path_src) writeLines(c( "d <- read.csv('data.csv')", "png('zzz.png')", "plot(d)", "dev.off()"), file.path(path_src, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src, "data.csv"), row.names = FALSE) inputs <- c("data.csv", "script.R") p <- outpack_packet_start_quietly(path_src, "example", root = root) expect_equal(outpack_packet_file_list(p), data_frame(path = inputs, status = "unknown")) outpack_packet_file_mark(p, inputs, "immutable") expect_equal(outpack_packet_file_list(p), data_frame(path = inputs, status = "immutable")) outpack_packet_run(p, "script.R") expect_equal(outpack_packet_file_list(p), data_frame(path = c(inputs, "zzz.png"), status = c("immutable", "immutable", "unknown"))) outpack_packet_file_mark(p, "zzz.png", "immutable") expect_equal(outpack_packet_file_list(p), data_frame(path = c(inputs, "zzz.png"), status = "immutable")) outpack_packet_end_quietly(p) }) test_that("Can detect changes to hashed files", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- temp_file() fs::dir_create(path_src) path_src <- temp_file() fs::dir_create(path_src) writeLines(c( "d <- read.csv('data.csv')", "file.create('data.csv')", # truncates file "png('myplot.png')", "plot(d)", "dev.off()"), file.path(path_src, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(path_src, "data.csv"), row.names = FALSE) inputs <- c("script.R", "data.csv") p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_file_mark(p, inputs, "immutable") outpack_packet_run(p, "script.R") err <- expect_error( outpack_packet_end_quietly(p), "File was changed after being added") expect_equal(err$body, c(x = "data.csv")) }) test_that("Re-adding files triggers hash", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- temp_file() fs::dir_create(path_src) write.csv(mtcars, file.path(path_src, "data.csv")) p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_file_mark(p, "data.csv", "immutable") expect_silent(outpack_packet_file_mark(p, "data.csv", "immutable")) expect_length(p$files, 1) file.create(file.path(path_src, "data.csv")) err <- expect_error(outpack_packet_file_mark(p, "data.csv", "immutable"), "File was changed after being added") expect_equal(err$body, c(x = "data.csv")) }) test_that("Can detect changes to dependencies", { root <- create_temporary_root() id <- create_random_packet(root, "data") path_src <- withr::local_tempdir() p <- outpack_packet_start_quietly(path_src, "next", root = root) outpack_packet_use_dependency(p, id, "data.rds") saveRDS(1:10, file.path(path_src, "data.rds")) err <- expect_error( outpack_packet_end_quietly(p), "File was changed after being added") expect_equal(err$body, c(x = "data.rds")) }) test_that("Can ignore files from the final packet", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- create_temporary_simple_src() inputs <- c("data.csv", "script.R") p <- outpack_packet_start_quietly(path_src, "example", root = root) expect_equal(outpack_packet_file_list(p), data_frame(path = inputs, status = "unknown")) outpack_packet_file_mark(p, "data.csv", "ignored") expect_equal(outpack_packet_file_list(p), data_frame(path = inputs, status = c("ignored", "unknown"))) outpack_packet_run(p, "script.R") expect_equal(outpack_packet_file_list(p), data_frame(path = c(inputs, "zzz.png"), status = c("ignored", "unknown", "unknown"))) outpack_packet_end_quietly(p) meta <- outpack_metadata_core(p$id, root) expect_equal(meta$files$path, c("script.R", "zzz.png")) expect_length(root$files$list(), 2) expect_setequal(dir(file.path(root$path, "archive", "example", p$id)), c("script.R", "zzz.png")) expect_setequal(dir(path_src), c("data.csv", "script.R", "zzz.png")) }) test_that("Files cannot be immutable and ignored", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- create_temporary_simple_src() p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_file_mark(p, "data.csv", "ignored") outpack_packet_file_mark(p, "script.R", "immutable") err <- expect_error( outpack_packet_file_mark(p, "data.csv", "immutable"), "Cannot mark ignored files as immutable") expect_equal(err$body, c(x = "data.csv")) err <- expect_error( outpack_packet_file_mark(p, "script.R", "ignored"), "Cannot mark immutable files as ignored") expect_equal(err$body, c(x = "script.R")) }) test_that("Validate a packet is incomplete", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- create_temporary_simple_src() p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_finish(p) expect_error(check_current_packet(p), "Packet '.+' is complete") }) test_that("can mark subsets of files immutably without error", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path_src <- temp_file() fs::dir_create(path_src) for (i in letters[1:6]) { writeLines(i, file.path(path_src, i)) } hash <- withr::with_dir(path_src, hash_files(letters[1:6], "sha256", named = TRUE)) p <- outpack_packet_start_quietly(path_src, "example", root = root) outpack_packet_file_mark(p, c("a", "b", "c"), "immutable") expect_equal(p$files$immutable, hash[1:3]) expect_silent( outpack_packet_file_mark(p, c("b", "c"), "immutable")) expect_equal(p$files$immutable, hash[1:3]) expect_silent( outpack_packet_file_mark(p, c("b", "e", "f"), "immutable")) expect_equal(p$files$immutable, hash[c("a", "b", "c", "e", "f")]) expect_silent( outpack_packet_file_mark(p, "d", "immutable")) expect_equal(p$files$immutable, hash[c("a", "b", "c", "e", "f", "d")]) expect_silent( outpack_packet_file_mark(p, names(hash), "immutable")) expect_equal(p$files$immutable, hash[c("a", "b", "c", "e", "f", "d")]) }) test_that("can depend based on a simple query", { root <- create_temporary_root(path_archive = NULL, use_file_store = TRUE) src <- withr::local_tempdir() src1 <- file.path(src, "1") src2 <- file.path(src, "2") fs::dir_create(c(src1, src2)) id <- list(a = character(), b = character()) for (i in 1:3) { for (name in c("a", "b")) { saveRDS(runif(10), file.path(src1, "data.rds")) p <- outpack_packet_start_quietly(src1, name, parameters = list(i = i), root = root) outpack_packet_end_quietly(p) id[[name]] <- c(id[[name]], p$id) } } p <- outpack_packet_start_quietly(src2, "x", root = root) outpack_packet_use_dependency(p, "latest", c("1.rds" = "data.rds")) expect_mapequal( p$depends[[1]], list(packet = id$b[[3]], query = "latest()", files = data.frame(here = "1.rds", there = "data.rds"))) query <- orderly_query("latest(parameter:i < 3)", name = "a") outpack_packet_use_dependency(p, query, c("2.rds" = "data.rds")) expect_mapequal( p$depends[[2]], list(packet = id$a[[2]], query = 'latest(parameter:i < 3 && name == "a")', files = data.frame(here = "2.rds", there = "data.rds"))) }) test_that("can depend based on a query with subqueries", { root <- create_temporary_root(path_archive = NULL, use_file_store = TRUE) src <- withr::local_tempdir() src_a <- file.path(src, "a") src_b <- file.path(src, "b") src_c <- file.path(src, "c") fs::dir_create(c(src_a, src_b, src_c)) id <- list(a = character()) for (i in 1:3) { saveRDS(runif(10), file.path(src_a, "data.rds")) p <- outpack_packet_start_quietly(src_a, "a", parameters = list(i = i), root = root) outpack_packet_end_quietly(p) id$a <- c(id$a, p$id) } p1 <- outpack_packet_start_quietly(src_b, "b", root = root) query1 <- orderly_query("latest(parameter:i < 3)", name = "a") outpack_packet_use_dependency(p1, query1, c("2.rds" = "data.rds")) outpack_packet_end_quietly(p1) id$b <- p1$id p2 <- outpack_packet_start_quietly(src_c, "c", root = root) query2 <- orderly_query("latest(usedby({B}))", name = "a", subquery = list(B = id$b)) outpack_packet_use_dependency(p2, query2, files = c("new.rds" = "data.rds")) outpack_packet_end_quietly(p2) expect_length(p2$depends, 1) expect_equal(p2$depends[[1]]$packet, id$a[[2]]) expect_equal(p2$depends[[1]]$query, sprintf('latest(usedby({"%s"}) && name == "a")', id$b)) }) test_that("validate that dependencies must evaluate to a single id", { path_src1 <- withr::local_tempdir() path_src2 <- withr::local_tempdir() root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) p1 <- outpack_packet_start_quietly(path_src1, "a", parameters = list(x = 1), root = root) saveRDS(runif(5), file.path(path_src1, "data.rds")) outpack_packet_end_quietly(p1) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) err <- expect_error( outpack_packet_use_dependency(p2, "parameter:x == 1", c("incoming.rds" = "data.rds")), "The provided query is not guaranteed to return a single value") expect_match(conditionMessage(err), "'parameter:x == 1'.+Did you forget latest\\(...\\)\\?") }) test_that("error if dependency cannot be resolved", { root <- create_temporary_root() path_src <- temp_file() fs::dir_create(path_src) p <- outpack_packet_start_quietly(path_src, "example", root = root) err <- expect_error( outpack_packet_use_dependency(p, quote(latest(name == "data")), c("data.rds" = "data.rds")), "Failed to find packet for query 'latest(name == \"data\")'", fixed = TRUE) expect_equal(err$body, c(i = "See 'rlang::last_error()$explanation' for details")) expect_equal(err$explanation, orderly_query_explain("latest", name = "data", root = root)) }) test_that("can pull in dependency from specific location", { root <- list() ids <- list() root$a <- create_temporary_root(use_file_store = TRUE) for (name in c("x", "y", "z")) { root[[name]] <- create_temporary_root(use_file_store = TRUE) ids[[name]] <- vcapply(1:3, function(i) { create_random_packet(root[[name]], "data", list(p = i)) }) orderly_location_add_path(name, path = root[[name]]$path, root = root$a) } orderly_location_fetch_metadata(root = root$a) for (id in ids$z) { suppressMessages(orderly_location_pull(id, root = root$a)) } path_src <- temp_file() fs::dir_create(path_src) p <- outpack_packet_start_quietly(path_src, "example", root = root$a) query <- quote(latest(name == "data" && parameter:p > 2)) options <- build_search_options(location = c("x", "y"), allow_remote = FALSE) expect_error( outpack_packet_use_dependency(p, query, c("data.rds" = "data.rds"), search_options = options), paste("Failed to find packet for query", "'latest(name == \"data\" && parameter:p > 2)'"), fixed = TRUE) for (id in ids$x) { suppressMessages(orderly_location_pull(id, root = root$a)) } outpack_packet_use_dependency(p, query, c("data1.rds" = "data.rds"), search_options = options) expect_equal(p$depends[[1]]$packet, ids$x[[3]]) for (id in ids$y) { suppressMessages(orderly_location_pull(id, root = root$a)) } outpack_packet_use_dependency(p, query, c("data2.rds" = "data.rds"), search_options = options) expect_equal(p$depends[[2]]$packet, ids$y[[3]]) }) test_that("can pull in dependency when not found, if requested", { root <- list() ids <- list() root$a <- create_temporary_root(use_file_store = TRUE) root$b <- create_temporary_root(use_file_store = TRUE, require_complete_tree = TRUE) root$x <- create_temporary_root(use_file_store = TRUE) ids <- vcapply(1:3, function(i) { create_random_packet(root$x, "data", list(p = i)) }) orderly_location_add_path("x", path = root$x$path, root = root$a) orderly_location_add_path("x", path = root$x$path, root = root$b) path_src_a <- withr::local_tempdir() query <- quote(latest(name == "data" && parameter:p > 2)) p_a <- outpack_packet_start_quietly(path_src_a, "example", root = root$a$path) expect_error( outpack_packet_use_dependency(p_a, query, c("data.rds" = "data.rds")), paste("Failed to find packet for query", "'latest(name == \"data\" && parameter:p > 2)'"), fixed = TRUE) expect_length(root$a$index$data()$metadata, 0) expect_equal(nrow(root$a$index$data()$location), 0) expect_equal(length(root$a$index$data()$unpacked), 0) options <- build_search_options(fetch_metadata = TRUE, allow_remote = TRUE) suppressMessages( outpack_packet_use_dependency(p_a, query, c("data.rds" = "data.rds"), search_options = options)) expect_length(root$a$index$data()$metadata, 3) expect_equal(nrow(root$a$index$data()$location), 3) expect_equal(root$a$index$data()$unpacked, character()) expect_equal(p_a$depends[[1]]$packet, ids[[3]]) path_src_b <- withr::local_tempdir() p_b <- outpack_packet_start_quietly(path_src_b, "example", root = root$b$path) suppressMessages( outpack_packet_use_dependency(p_b, query, c("data.rds" = "data.rds"), search_options = options)) expect_length(root$b$index$data()$metadata, 3) expect_equal(nrow(root$b$index$data()$location), 4) # compare with above! expect_equal(root$b$index$data()$unpacked, ids[[3]]) expect_equal(p_b$depends[[1]]$packet, ids[[3]]) }) test_that("can pull in directories", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path path_src1 <- withr::local_tempdir() p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) fs::dir_create(file.path(path_src1, "data")) for (i in letters[1:6]) { writeLines(i, file.path(path_src1, "data", i)) } outpack_packet_end_quietly(p1) id <- p1$id dest <- withr::local_tempdir() suppressMessages( orderly_copy_files(id, files = c(d = "data/"), dest = dest, root = root)) expect_equal(dir(dest), "d") expect_equal(dir(file.path(dest, "d")), letters[1:6]) path_src2 <- withr::local_tempdir() p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) outpack_packet_use_dependency(p2, 'latest(name == "a")', c(d = "data/")) expect_equal(p2$depends[[1]]$files, data_frame(here = file.path("d", letters[1:6]), there = file.path("data", letters[1:6]))) }) test_that("exporting directories reports on trailing slashes being missing", { root <- create_temporary_root(path_archive = "archive", use_file_store = TRUE) path <- root$path path_src1 <- withr::local_tempdir() p1 <- outpack_packet_start_quietly(path_src1, "a", root = root) fs::dir_create(file.path(path_src1, "data")) for (i in letters[1:6]) { writeLines(i, file.path(path_src1, "data", i)) } outpack_packet_end_quietly(p1) id <- p1$id dest <- withr::local_tempdir() err <- expect_error( orderly_copy_files(id, files = c(d = "data"), dest = dest, root = root), "Packet '.+' does not contain the requested path") expect_equal(err$body, c(i = "Consider adding a trailing slash to 'data'")) path_src2 <- withr::local_tempdir() p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) expect_error( outpack_packet_use_dependency(p2, 'latest(name == "a")', c(d = "data")), "Packet '.+' does not contain the requested path") }) test_that("can overwrite dependencies", { root <- create_temporary_root() id <- create_random_packet(root, "data") path_src <- withr::local_tempdir() p <- outpack_packet_start_quietly(path_src, "next", root = root) file.create(file.path(path_src, "data.rds")) err <- expect_error( outpack_packet_use_dependency(p, id, c("data.rds" = "data.rds"), overwrite = FALSE)) ## Default allows overwrite: expect_silent( outpack_packet_use_dependency(p, id, c("data.rds" = "data.rds"))) expect_equal( hash_file(file.path(path_src, "data.rds")), hash_file(file.path(root$path, "archive", "data", id, "data.rds"))) }) test_that("metadata files match their hash", { root <- create_temporary_root() id <- create_random_packet(root) location <- root$index$location(local) expected_hash <- location[location$packet == id]$hash path <- file.path(root$path, ".outpack", "metadata", id) expect_no_error(hash_validate_file(path, expected_hash)) }) test_that("Files in the archive are read-only", { skip_on_cran() src <- temp_file() fs::dir_create(src) writeLines(c( "d <- read.csv('data.csv')", "png('myplot.png')", "plot(d)", "dev.off()"), file.path(src, "script.R")) write.csv(data.frame(x = 1:10, y = runif(10)), file.path(src, "data.csv"), row.names = FALSE) root <- create_temporary_root(path_archive = "archive", use_file_store = FALSE) path <- root$path p <- outpack_packet_start_quietly(src, "a", root = root) outpack_packet_run(p, "script.R") outpack_packet_end_quietly(p) files <- c("data.csv", "script.R", "myplot.png") files_path <- file.path(path, "archive", "a", p$id, files) expect_true(all(fs::file_access(files_path, "read"))) expect_true(all(!fs::file_access(files_path, "write"))) })